From f37470f970a00eaa96eed1241eee48496b56ff48 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 3 Oct 2023 11:59:34 +0200 Subject: [PATCH] Revert "Strings of length < 80 are trivial and simple" This reverts commit 55ebbe5e063fe7cdd13e32dbd7676fdd69fa1c75. --- lib/Ast.ml | 10 ++++++++-- lib/Conf_decl.ml | 18 ++++++++++-------- lib/Translation_unit.ml | 10 ++++++---- lib/box_debug.ml | 3 ++- .../passing/tests/doc_comments-no-wrap.mli.ref | 8 ++++---- test/passing/tests/doc_comments.mli.ref | 8 ++++---- test/passing/tests/infix_arg_grouping.ml | 4 ++-- test/rpc/rpc_test.ml | 3 ++- test/rpc/rpc_test_fail.ml | 3 ++- 9 files changed, 40 insertions(+), 27 deletions(-) diff --git a/lib/Ast.ml b/lib/Ast.ml index 829595482c..a1c0f7ed86 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -146,7 +146,7 @@ module Exp = struct | Pexp_constant {pconst_desc= Pconst_string (_, _, Some _); _} -> false (* Short strings are trivial. *) | Pexp_constant {pconst_desc= Pconst_string (str, _, None); _} -> - String.length str < 80 + String.length str < 30 | Pexp_constant _ | Pexp_field _ | Pexp_ident _ | Pexp_send _ -> true | Pexp_construct (_, exp) -> Option.for_all exp ~f:is_trivial | Pexp_prefix (_, e) -> is_trivial e @@ -1474,7 +1474,13 @@ end = struct let rec is_simple (c : Conf.t) width ({ast= exp; _} as xexp) = let ctx = Exp exp in match exp.pexp_desc with - | Pexp_constant _ -> Exp.is_trivial exp + (* String literals using the heavy syntax are not simple. *) + | Pexp_constant {pconst_desc= Pconst_string (_, _, Some _); _} -> false + (* Only strings fitting on the line are simple. *) + | Pexp_constant {pconst_desc= Pconst_string (_, loc, None); _} -> + Exp.is_trivial exp + || (Location.height loc = 1 && fit_margin c (width xexp)) + | Pexp_constant _ -> true | Pexp_field _ | Pexp_ident _ | Pexp_send _ |Pexp_construct (_, None) |Pexp_variant (_, None) -> diff --git a/lib/Conf_decl.ml b/lib/Conf_decl.ml index 75d93ab1e4..4b1050689f 100644 --- a/lib/Conf_decl.ml +++ b/lib/Conf_decl.ml @@ -208,7 +208,8 @@ let status_doc ppf = function let generated_flag_doc ~allow_inline ~doc ~kind ~default ~status = let default = if default then "set" else "unset" in - Format.asprintf "%s The flag is $(b,%s) by default.%s%a" doc default + Format.asprintf "%s The flag is $(b,%s) by default.%s%a" + doc default (in_attributes allow_inline kind) status_doc status @@ -217,7 +218,8 @@ let generated_doc conv ~allow_inline ~doc ~kind ~default ~status = let default = if String.is_empty default_doc then "none" else default_doc in - Format.asprintf "%s The default value is $(b,%s).%s%a" doc default + Format.asprintf "%s The default value is $(b,%s).%s%a" + doc default (in_attributes allow_inline kind) status_doc status @@ -325,13 +327,13 @@ module Value = struct | Some x -> (name, value, doc, `Deprecated x) let pp_deprecated s ppf {dmsg= msg; dversion= v} = - Format.fprintf ppf "Value `%s` is deprecated since version %a. %s" s - Version.pp v msg + Format.fprintf ppf "Value `%s` is deprecated since version %a. %s" + s Version.pp v msg let pp_deprecated_with_name ~opt ~val_ ppf {dmsg= msg; dversion= v} = Format.fprintf ppf - "option `%s`: value `%s` is deprecated since version %a. %s" opt val_ - Version.pp v msg + "option `%s`: value `%s` is deprecated since version %a. %s" + opt val_ Version.pp v msg let status_doc s ppf = function | `Valid -> () @@ -360,8 +362,8 @@ module Value_removed = struct | Some {name; version; msg} -> Format.kasprintf (fun s -> Error (`Msg s)) - "value `%s` has been removed in version %a.%s" name Version.pp - version (maybe_empty msg) + "value `%s` has been removed in version %a.%s" + name Version.pp version (maybe_empty msg) | None -> Arg.conv_parser conv s in Arg.conv (parse, Arg.conv_printer conv) diff --git a/lib/Translation_unit.ml b/lib/Translation_unit.ml index cc7281e4bf..842bd5fde0 100644 --- a/lib/Translation_unit.ml +++ b/lib/Translation_unit.ml @@ -55,7 +55,8 @@ module Error = struct Out_channel.write_all n ~data:next ; ignore (Stdlib.Sys.command - (Printf.sprintf "git diff --no-index -u %S %S | sed '1,4d' 1>&2" p n) ) ; + (Printf.sprintf "git diff --no-index -u %S %S | sed '1,4d' 1>&2" + p n ) ) ; Stdlib.Sys.remove p ; Stdlib.Sys.remove n @@ -113,8 +114,8 @@ module Error = struct if debug then print_diff input_name ~prev ~next ; if iteration <= 1 then Format.fprintf fmt - "%s: %S was not already formatted. ([max-iters = 1])\n%!" exe - input_name + "%s: %S was not already formatted. ([max-iters = 1])\n%!" + exe input_name else ( Format.fprintf fmt "%s: Cannot process %S.\n\ @@ -179,7 +180,8 @@ let check_margin (conf : Conf.t) ~filename ~fmted = List.iteri (String.split_lines fmted) ~f:(fun i line -> if String.length line > conf.fmt_opts.margin.v then Format.fprintf Format.err_formatter - "Warning: %s:%i exceeds the margin\n%!" filename i ) + "Warning: %s:%i exceeds the margin\n%!" + filename i ) let with_optional_box_debug ~box_debug k = if box_debug then Fmt.with_box_debug k else k diff --git a/lib/box_debug.ml b/lib/box_debug.ml index 29247b39b9..f4db9027ff 100644 --- a/lib/box_debug.ml +++ b/lib/box_debug.ml @@ -101,7 +101,8 @@ let break fs n o = if !debug then fprintf fs "
(%i,%i)break %i \ - %i
" n o n o + %i" + n o n o let pp_keyword fs s = fprintf fs "%s" s diff --git a/test/passing/tests/doc_comments-no-wrap.mli.ref b/test/passing/tests/doc_comments-no-wrap.mli.ref index bf0cfed150..f00e96efab 100644 --- a/test/passing/tests/doc_comments-no-wrap.mli.ref +++ b/test/passing/tests/doc_comments-no-wrap.mli.ref @@ -401,14 +401,14 @@ end #use "import.cinaps" ;; List.iter all_fields ~f:(fun (name, type_) -> - printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ - name ) + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" + name type_ name ) ]} *) (** {[ List.iter all_fields ~f:(fun (name, type_) -> - printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ - name ) + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" + name type_ name ) ]} *) (** {[ diff --git a/test/passing/tests/doc_comments.mli.ref b/test/passing/tests/doc_comments.mli.ref index 04cdb10d17..941f850838 100644 --- a/test/passing/tests/doc_comments.mli.ref +++ b/test/passing/tests/doc_comments.mli.ref @@ -401,14 +401,14 @@ end #use "import.cinaps" ;; List.iter all_fields ~f:(fun (name, type_) -> - printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ - name ) + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" + name type_ name ) ]} *) (** {[ List.iter all_fields ~f:(fun (name, type_) -> - printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ - name ) + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" + name type_ name ) ]} *) (** {[ diff --git a/test/passing/tests/infix_arg_grouping.ml b/test/passing/tests/infix_arg_grouping.ml index 896dd2b781..a083ab05d7 100644 --- a/test/passing/tests/infix_arg_grouping.ml +++ b/test/passing/tests/infix_arg_grouping.ml @@ -5,8 +5,8 @@ vbox 1 ;; user_error - ( "version mismatch: .ocamlformat requested " ^ value ^ " but version is " - ^ Version.version ) + ( "version mismatch: .ocamlformat requested " + ^ value ^ " but version is " ^ Version.version ) ;; hvbox 1 diff --git a/test/rpc/rpc_test.ml b/test/rpc/rpc_test.ml index 17de0ab390..c91a73be3c 100644 --- a/test/rpc/rpc_test.ml +++ b/test/rpc/rpc_test.ml @@ -79,7 +79,8 @@ let start ?versions () = log "An error occured while initializing and configuring ocamlformat:\n\ %s\n\ - %!" msg ; + %!" + msg ; `No_process ) let get_client ?versions () = diff --git a/test/rpc/rpc_test_fail.ml b/test/rpc/rpc_test_fail.ml index 2a9fbda9fe..683446e7dc 100644 --- a/test/rpc/rpc_test_fail.ml +++ b/test/rpc/rpc_test_fail.ml @@ -77,7 +77,8 @@ let start () = log "An error occured while initializing and configuring ocamlformat:\n\ %s\n\ - %!" msg ; + %!" + msg ; `No_process ) let get_client () =