From 016277940bda03182a1998c9d1d714ebd59f1772 Mon Sep 17 00:00:00 2001 From: David Vulakh Date: Wed, 15 Nov 2023 12:19:21 -0500 Subject: [PATCH 1/2] always treat multiline {||} strings as though they are long --- lib/Fmt.mli | 3 ++ lib/Fmt_ast.ml | 31 +++++++++++---------- test/failing/gen/gen.ml | 6 ++-- test/passing/gen/gen.ml | 6 ++-- test/passing/tests/crlf_to_crlf.ml.ref | 3 +- test/passing/tests/crlf_to_lf.ml.ref | 3 +- test/passing/tests/extensions-indent.ml.ref | 6 ++-- test/passing/tests/extensions.ml.ref | 6 ++-- test/passing/tests/js_source.ml.err | 8 +++--- test/passing/tests/js_source.ml.ocp | 24 ++++++++++------ test/passing/tests/js_source.ml.ref | 24 ++++++++++------ test/passing/tests/source.ml.ref | 18 ++++++++---- 12 files changed, 88 insertions(+), 50 deletions(-) diff --git a/lib/Fmt.mli b/lib/Fmt.mli index af6e2040a6..e996b01789 100644 --- a/lib/Fmt.mli +++ b/lib/Fmt.mli @@ -76,6 +76,9 @@ val char : char -> t val str : string -> t (** Format a string. *) +val str_as : int -> string -> t +(** [str_as a len] formats a string as if it were of length [len]. *) + (** Primitive containers ------------------------------------------------*) val opt : 'a option -> ('a -> t) -> t diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 6028010f44..a8480d4d8d 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -261,8 +261,11 @@ let fmt_constant c ?epi {pconst_desc; pconst_loc= loc} = str lit $ opt suf char | Pconst_char (_, s) -> wrap "'" "'" @@ str s | Pconst_string (s, loc', Some delim) -> - Cmts.fmt c loc' - @@ wrap_k (str ("{" ^ delim ^ "|")) (str ("|" ^ delim ^ "}")) (str s) + Cmts.fmt c loc' @@ str (Format_.sprintf "{%s|%s|%s}" delim s delim) + (* If a multiline string has newlines in it, it should get treated as a + "long" box element. To do so, we append a length-1000 empty + string. *) + $ fmt_if_k (String.mem s '\n') (str_as 1000 "") | Pconst_string (_, loc', None) -> ( let delim = ["@,"; "@;"] in let contains_pp_commands s = @@ -513,18 +516,18 @@ let sequence_blank_line c (l1 : Location.t) (l2 : Location.t) = loop l1.loc_end (Cmts.remaining_before c.cmts l2) | `Compact -> false -let fmt_quoted_string key ext s = function - | None -> - wrap_k (str (Format_.sprintf "{%s%s|" key ext)) (str "|}") (str s) - | Some delim -> - let ext_and_delim = - if String.is_empty delim then ext - else Format_.sprintf "%s %s" ext delim - in - wrap_k - (str (Format_.sprintf "{%s%s|" key ext_and_delim)) - (str (Format_.sprintf "|%s}" delim)) - (str s) +let fmt_quoted_string key ext s maybe_delim = + let s_fmt = + match maybe_delim with + | None -> str (Format_.sprintf "{%s%s|%s|}" key ext s) + | Some delim -> + let ext_and_delim = + if String.is_empty delim then ext + else Format_.sprintf "%s %s" ext delim + in + str (Format_.sprintf "{%s%s|%s|%s}" key ext_and_delim s delim) + in + s_fmt $ fmt_if_k (String.mem s '\n') (str_as 1000 "") let fmt_type_var s = str "'" diff --git a/test/failing/gen/gen.ml b/test/failing/gen/gen.ml index 58a69a0c30..a3acff2a39 100644 --- a/test/failing/gen/gen.ml +++ b/test/failing/gen/gen.ml @@ -76,8 +76,10 @@ let register_file tests fname = let cmd args = let cmd_string = String.concat " " args in - Printf.sprintf {|(with-accepted-exit-codes 1 - (run %s))|} cmd_string + Printf.sprintf + {|(with-accepted-exit-codes 1 + (run %s))|} + cmd_string let emit_test test_name setup = let opts = diff --git a/test/passing/gen/gen.ml b/test/passing/gen/gen.ml index 1f8dca695c..b05ec6f210 100644 --- a/test/passing/gen/gen.ml +++ b/test/passing/gen/gen.ml @@ -89,8 +89,10 @@ let register_file tests fname = let cmd should_fail args = let cmd_string = String.concat " " args in if should_fail then - spf {|(with-accepted-exit-codes 1 - (run %s))|} cmd_string + spf + {|(with-accepted-exit-codes 1 + (run %s))|} + cmd_string else spf {|(run %s)|} cmd_string let emit_test test_name setup = diff --git a/test/passing/tests/crlf_to_crlf.ml.ref b/test/passing/tests/crlf_to_crlf.ml.ref index d4dad84ea5..95a1f84058 100644 --- a/test/passing/tests/crlf_to_crlf.ml.ref +++ b/test/passing/tests/crlf_to_crlf.ml.ref @@ -1,4 +1,5 @@ -let _ = {| +let _ = + {| foo bar diff --git a/test/passing/tests/crlf_to_lf.ml.ref b/test/passing/tests/crlf_to_lf.ml.ref index 095adcbfb7..3691c196f0 100644 --- a/test/passing/tests/crlf_to_lf.ml.ref +++ b/test/passing/tests/crlf_to_lf.ml.ref @@ -1,4 +1,5 @@ -let _ = {| +let _ = + {| foo bar diff --git a/test/passing/tests/extensions-indent.ml.ref b/test/passing/tests/extensions-indent.ml.ref index 7b730b8c8a..8fcab5bfbd 100644 --- a/test/passing/tests/extensions-indent.ml.ref +++ b/test/passing/tests/extensions-indent.ml.ref @@ -185,11 +185,13 @@ let this_function_has_a_long_name plus very many arguments = [%%expect {||}] ;; -[%expect {| +[%expect + {| ___________________________________________________________ |}] -[%%expect {| +[%%expect + {| ___________________________________________________________ |}] diff --git a/test/passing/tests/extensions.ml.ref b/test/passing/tests/extensions.ml.ref index 3dbe10d019..5eafd633d2 100644 --- a/test/passing/tests/extensions.ml.ref +++ b/test/passing/tests/extensions.ml.ref @@ -185,11 +185,13 @@ let this_function_has_a_long_name plus very many arguments = [%%expect {||}] ;; -[%expect {| +[%expect + {| ___________________________________________________________ |}] -[%%expect {| +[%%expect +{| ___________________________________________________________ |}] diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 95f7fb8536..1d9cfa32c9 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,5 +1,5 @@ Warning: tests/js_source.ml:155 exceeds the margin -Warning: tests/js_source.ml:9531 exceeds the margin -Warning: tests/js_source.ml:9634 exceeds the margin -Warning: tests/js_source.ml:9693 exceeds the margin -Warning: tests/js_source.ml:9775 exceeds the margin +Warning: tests/js_source.ml:9537 exceeds the margin +Warning: tests/js_source.ml:9640 exceeds the margin +Warning: tests/js_source.ml:9699 exceeds the margin +Warning: tests/js_source.ml:9781 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 889cce31c5..aefdfbbbaa 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -3154,7 +3154,8 @@ module FM_valid = F (struct type t = int end) -[%%expect {| +[%%expect + {| module M_valid : S module FM_valid : S |}] @@ -3170,7 +3171,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect + {| module Foo : sig type t val x : t ref end |}] @@ -3184,7 +3186,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect + {| module Bar : sig type t [@@immediate] val x : t ref end |}] @@ -3194,7 +3197,8 @@ let test f = Sys.time () -. start ;; -[%%expect {| +[%%expect + {| val test : (unit -> 'a) -> float = |}] @@ -3204,7 +3208,8 @@ let test_foo () = done ;; -[%%expect {| +[%%expect + {| val test_foo : unit -> unit = |}] @@ -3214,7 +3219,8 @@ let test_bar () = done ;; -[%%expect {| +[%%expect + {| val test_bar : unit -> unit = |}] @@ -10330,8 +10336,10 @@ zzzzzzzzzzzzzzzzzzzzzzzzzzzz *) (*$*) -(*$ {| - f|} *) +(*$ + {| + f|} +*) let () = match () with diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index a60e340e05..8178dac048 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -3154,7 +3154,8 @@ module FM_valid = F (struct type t = int end) -[%%expect {| +[%%expect + {| module M_valid : S module FM_valid : S |}] @@ -3170,7 +3171,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect + {| module Foo : sig type t val x : t ref end |}] @@ -3184,7 +3186,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect + {| module Bar : sig type t [@@immediate] val x : t ref end |}] @@ -3194,7 +3197,8 @@ let test f = Sys.time () -. start ;; -[%%expect {| +[%%expect + {| val test : (unit -> 'a) -> float = |}] @@ -3204,7 +3208,8 @@ let test_foo () = done ;; -[%%expect {| +[%%expect + {| val test_foo : unit -> unit = |}] @@ -3214,7 +3219,8 @@ let test_bar () = done ;; -[%%expect {| +[%%expect + {| val test_bar : unit -> unit = |}] @@ -10330,8 +10336,10 @@ zzzzzzzzzzzzzzzzzzzzzzzzzzzz *) (*$*) -(*$ {| - f|} *) +(*$ + {| + f|} +*) let () = match () with diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 8ffdea57f5..8371e83f2c 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -3006,7 +3006,8 @@ module FM_valid = F (struct type t = int end) -[%%expect {| +[%%expect +{| module M_valid : S module FM_valid : S |}] @@ -3022,7 +3023,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect +{| module Foo : sig type t val x : t ref end |}] @@ -3036,7 +3038,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect +{| module Bar : sig type t [@@immediate] val x : t ref end |}] @@ -3045,7 +3048,8 @@ let test f = f () ; Sys.time () -. start -[%%expect {| +[%%expect +{| val test : (unit -> 'a) -> float = |}] @@ -3054,7 +3058,8 @@ let test_foo () = Foo.x := !Foo.x done -[%%expect {| +[%%expect +{| val test_foo : unit -> unit = |}] @@ -3063,7 +3068,8 @@ let test_bar () = Bar.x := !Bar.x done -[%%expect {| +[%%expect +{| val test_bar : unit -> unit = |}] From df34d812fe611894bf98eef3c30a7c2d9017350f Mon Sep 17 00:00:00 2001 From: David Vulakh Date: Tue, 21 Nov 2023 15:19:48 -0500 Subject: [PATCH 2/2] only change treatment of multiline {||} in janestreet profile after this commit, only the js_source.ml.* tests change as compared to the trunk --- lib/Conf.ml | 3 ++ lib/Conf_t.ml | 1 + lib/Conf_t.mli | 1 + lib/Fmt_ast.ml | 42 ++++++++++++--------- test/failing/gen/gen.ml | 6 +-- test/passing/gen/gen.ml | 6 +-- test/passing/tests/crlf_to_crlf.ml.ref | 3 +- test/passing/tests/crlf_to_lf.ml.ref | 3 +- test/passing/tests/extensions-indent.ml.ref | 6 +-- test/passing/tests/extensions.ml.ref | 6 +-- test/passing/tests/source.ml.ref | 18 +++------ 11 files changed, 45 insertions(+), 50 deletions(-) diff --git a/lib/Conf.ml b/lib/Conf.ml index be35cd1e53..a4512c6a74 100644 --- a/lib/Conf.ml +++ b/lib/Conf.ml @@ -50,6 +50,7 @@ let conventional_profile from = let elt content = Elt.make content from in { align_symbol_open_paren= elt true ; assignment_operator= elt `End_line + ; break_around_multiline_strings= elt false ; break_before_in= elt `Fit_or_vertical ; break_cases= elt `Fit ; break_collection_expressions= elt `Fit_or_vertical @@ -118,6 +119,7 @@ let ocamlformat_profile from = let elt content = Elt.make content from in { align_symbol_open_paren= elt true ; assignment_operator= elt `End_line + ; break_around_multiline_strings= elt false ; break_before_in= elt `Fit_or_vertical ; break_cases= elt `Nested ; break_collection_expressions= elt `Fit_or_vertical @@ -184,6 +186,7 @@ let janestreet_profile from = let elt content = Elt.make content from in { align_symbol_open_paren= elt false ; assignment_operator= elt `Begin_line + ; break_around_multiline_strings= elt true ; break_before_in= elt `Fit_or_vertical ; break_cases= elt `Fit_or_vertical ; break_collection_expressions= diff --git a/lib/Conf_t.ml b/lib/Conf_t.ml index 59f0c6b458..0958eb2ad2 100644 --- a/lib/Conf_t.ml +++ b/lib/Conf_t.ml @@ -55,6 +55,7 @@ type 'a elt = 'a Elt.t type fmt_opts = { align_symbol_open_paren: bool elt ; assignment_operator: [`Begin_line | `End_line] elt + ; break_around_multiline_strings: bool elt ; break_before_in: [`Fit_or_vertical | `Auto] elt ; break_cases: [`Fit | `Nested | `Toplevel | `Fit_or_vertical | `All | `Vertical] elt diff --git a/lib/Conf_t.mli b/lib/Conf_t.mli index 853e321d8e..a8a8bf87da 100644 --- a/lib/Conf_t.mli +++ b/lib/Conf_t.mli @@ -51,6 +51,7 @@ type 'a elt = 'a Elt.t type fmt_opts = { align_symbol_open_paren: bool elt ; assignment_operator: [`Begin_line | `End_line] elt + ; break_around_multiline_strings: bool elt ; break_before_in: [`Fit_or_vertical | `Auto] elt ; break_cases: [`Fit | `Nested | `Toplevel | `Fit_or_vertical | `Vertical | `All] elt diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index a8480d4d8d..20c3626fab 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -261,11 +261,16 @@ let fmt_constant c ?epi {pconst_desc; pconst_loc= loc} = str lit $ opt suf char | Pconst_char (_, s) -> wrap "'" "'" @@ str s | Pconst_string (s, loc', Some delim) -> - Cmts.fmt c loc' @@ str (Format_.sprintf "{%s|%s|%s}" delim s delim) - (* If a multiline string has newlines in it, it should get treated as a - "long" box element. To do so, we append a length-1000 empty - string. *) - $ fmt_if_k (String.mem s '\n') (str_as 1000 "") + Cmts.fmt c loc' + @@ (* If a multiline string has newlines in it, the configuration might + specify it should get treated as a "long" box element. To do so, + we pretend it is 1000 characters long. *) + ( if + c.conf.fmt_opts.break_around_multiline_strings.v + && String.mem s '\n' + then str_as 1000 + else str ) + (Format_.sprintf "{%s|%s|%s}" delim s delim) | Pconst_string (_, loc', None) -> ( let delim = ["@,"; "@;"] in let contains_pp_commands s = @@ -516,18 +521,19 @@ let sequence_blank_line c (l1 : Location.t) (l2 : Location.t) = loop l1.loc_end (Cmts.remaining_before c.cmts l2) | `Compact -> false -let fmt_quoted_string key ext s maybe_delim = - let s_fmt = - match maybe_delim with - | None -> str (Format_.sprintf "{%s%s|%s|}" key ext s) - | Some delim -> - let ext_and_delim = - if String.is_empty delim then ext - else Format_.sprintf "%s %s" ext delim - in - str (Format_.sprintf "{%s%s|%s|%s}" key ext_and_delim s delim) - in - s_fmt $ fmt_if_k (String.mem s '\n') (str_as 1000 "") +let fmt_quoted_string c key ext s maybe_delim = + ( if c.conf.fmt_opts.break_around_multiline_strings.v && String.mem s '\n' + then str_as 1000 + else str ) + @@ + match maybe_delim with + | None -> Format_.sprintf "{%s%s|%s|}" key ext s + | Some delim -> + let ext_and_delim = + if String.is_empty delim then ext + else Format_.sprintf "%s %s" ext delim + in + Format_.sprintf "{%s%s|%s|%s}" key ext_and_delim s delim let fmt_type_var s = str "'" @@ -560,7 +566,7 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) = assert (not (Cmts.has_after c.cmts pexp_loc)) ; assert (not (Cmts.has_before c.cmts pstr_loc)) ; assert (not (Cmts.has_after c.cmts pstr_loc)) ; - hvbox 0 (fmt_quoted_string (Ext.Key.to_string key) ext str delim) + hvbox 0 (fmt_quoted_string c (Ext.Key.to_string key) ext str delim) | _, PStr [({pstr_loc; _} as si)], (Pld _ | Str _ | Top) when Source.extension_using_sugar ~name:ext ~payload:pstr_loc -> fmt_structure_item c ~last:true ~ext ~semisemi:false (sub_str ~ctx si) diff --git a/test/failing/gen/gen.ml b/test/failing/gen/gen.ml index a3acff2a39..58a69a0c30 100644 --- a/test/failing/gen/gen.ml +++ b/test/failing/gen/gen.ml @@ -76,10 +76,8 @@ let register_file tests fname = let cmd args = let cmd_string = String.concat " " args in - Printf.sprintf - {|(with-accepted-exit-codes 1 - (run %s))|} - cmd_string + Printf.sprintf {|(with-accepted-exit-codes 1 + (run %s))|} cmd_string let emit_test test_name setup = let opts = diff --git a/test/passing/gen/gen.ml b/test/passing/gen/gen.ml index b05ec6f210..1f8dca695c 100644 --- a/test/passing/gen/gen.ml +++ b/test/passing/gen/gen.ml @@ -89,10 +89,8 @@ let register_file tests fname = let cmd should_fail args = let cmd_string = String.concat " " args in if should_fail then - spf - {|(with-accepted-exit-codes 1 - (run %s))|} - cmd_string + spf {|(with-accepted-exit-codes 1 + (run %s))|} cmd_string else spf {|(run %s)|} cmd_string let emit_test test_name setup = diff --git a/test/passing/tests/crlf_to_crlf.ml.ref b/test/passing/tests/crlf_to_crlf.ml.ref index 95a1f84058..d4dad84ea5 100644 --- a/test/passing/tests/crlf_to_crlf.ml.ref +++ b/test/passing/tests/crlf_to_crlf.ml.ref @@ -1,5 +1,4 @@ -let _ = - {| +let _ = {| foo bar diff --git a/test/passing/tests/crlf_to_lf.ml.ref b/test/passing/tests/crlf_to_lf.ml.ref index 3691c196f0..095adcbfb7 100644 --- a/test/passing/tests/crlf_to_lf.ml.ref +++ b/test/passing/tests/crlf_to_lf.ml.ref @@ -1,5 +1,4 @@ -let _ = - {| +let _ = {| foo bar diff --git a/test/passing/tests/extensions-indent.ml.ref b/test/passing/tests/extensions-indent.ml.ref index 8fcab5bfbd..7b730b8c8a 100644 --- a/test/passing/tests/extensions-indent.ml.ref +++ b/test/passing/tests/extensions-indent.ml.ref @@ -185,13 +185,11 @@ let this_function_has_a_long_name plus very many arguments = [%%expect {||}] ;; -[%expect - {| +[%expect {| ___________________________________________________________ |}] -[%%expect - {| +[%%expect {| ___________________________________________________________ |}] diff --git a/test/passing/tests/extensions.ml.ref b/test/passing/tests/extensions.ml.ref index 5eafd633d2..3dbe10d019 100644 --- a/test/passing/tests/extensions.ml.ref +++ b/test/passing/tests/extensions.ml.ref @@ -185,13 +185,11 @@ let this_function_has_a_long_name plus very many arguments = [%%expect {||}] ;; -[%expect - {| +[%expect {| ___________________________________________________________ |}] -[%%expect -{| +[%%expect {| ___________________________________________________________ |}] diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 8371e83f2c..8ffdea57f5 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -3006,8 +3006,7 @@ module FM_valid = F (struct type t = int end) -[%%expect -{| +[%%expect {| module M_valid : S module FM_valid : S |}] @@ -3023,8 +3022,7 @@ end = struct let x = ref 0 end -[%%expect -{| +[%%expect {| module Foo : sig type t val x : t ref end |}] @@ -3038,8 +3036,7 @@ end = struct let x = ref 0 end -[%%expect -{| +[%%expect {| module Bar : sig type t [@@immediate] val x : t ref end |}] @@ -3048,8 +3045,7 @@ let test f = f () ; Sys.time () -. start -[%%expect -{| +[%%expect {| val test : (unit -> 'a) -> float = |}] @@ -3058,8 +3054,7 @@ let test_foo () = Foo.x := !Foo.x done -[%%expect -{| +[%%expect {| val test_foo : unit -> unit = |}] @@ -3068,8 +3063,7 @@ let test_bar () = Bar.x := !Bar.x done -[%%expect -{| +[%%expect {| val test_bar : unit -> unit = |}]