From d0a28cf7ff464962fe6b82c4d8b9ca7a32b1d0ef Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 8 Nov 2023 11:00:22 +0100 Subject: [PATCH] Refactor handling of comments (#2371) This rewrite part of the code that parses and formats comments to remove repeated or inconsistent code. One function interprets comments: Cmt.decode. It returns a richer type that allow to implement formatting as it was before. The normalization is changed to use that, no more is_docstring and normalization of indentation is now consistent. This fixes normalization problem for comments parsed as doc and cinaps comments. Improvements are: - Asterisk-prefixed comments are formatted specially. The code was present but was never called. - Commented-out code is no longer wrapped. - Fix a bug where formatted cinaps comments wouldn't pass normalization. Co-authored-by: Guillaume Petiot --- CHANGES.md | 1 + lib/Cmt.ml | 134 ++++-- lib/Cmt.mli | 27 +- lib/Cmts.ml | 271 +++++------ lib/Cmts.mli | 7 - lib/Fmt.ml | 36 -- lib/Fmt.mli | 5 - lib/Normalize_extended_ast.ml | 138 +++--- lib/Normalize_extended_ast.mli | 4 - lib/Translation_unit.ml | 6 +- test/passing/dune.inc | 20 +- .../passing/tests/break_before_in-auto.ml.err | 0 test/passing/tests/break_before_in.ml.err | 0 .../passing/tests/break_fun_decl-smart.ml.err | 0 .../tests/break_separators-after.ml.err | 1 + .../tests/break_separators-after.ml.ref | 3 +- .../break_separators-after_docked.ml.err | 3 +- .../break_separators-after_docked.ml.ref | 3 +- .../break_separators-before_docked.ml.err | 1 + .../break_separators-before_docked.ml.ref | 3 +- test/passing/tests/break_separators.ml | 3 +- test/passing/tests/break_separators.ml.err | 1 + .../tests/break_sequence_before.ml.err | 0 .../tests/break_string_literals.ml.err | 0 test/passing/tests/break_struct.ml.err | 0 test/passing/tests/cases_exp_grouping.ml.err | 0 test/passing/tests/cinaps.ml | 22 + test/passing/tests/cinaps.ml.err | 2 +- test/passing/tests/cinaps.ml.ref | 11 + test/passing/tests/comment_header.ml.ref | 2 +- test/passing/tests/comments-no-wrap.ml.err | 5 + test/passing/tests/comments-no-wrap.ml.opts | 2 + test/passing/tests/comments-no-wrap.ml.ref | 437 ++++++++++++++++++ test/passing/tests/comments.ml | 15 + test/passing/tests/comments.ml.ref | 11 + test/passing/tests/disambiguate.ml.err | 0 test/passing/tests/doc_comments-after.ml.err | 5 +- test/passing/tests/doc_comments-after.ml.ref | 8 +- .../doc_comments-before-except-val.ml.err | 5 +- .../doc_comments-before-except-val.ml.ref | 8 +- test/passing/tests/doc_comments-before.ml.err | 5 +- test/passing/tests/doc_comments-before.ml.ref | 8 +- test/passing/tests/doc_comments.ml.err | 5 +- test/passing/tests/doc_comments.ml.ref | 8 +- test/passing/tests/exp_grouping-parens.ml.err | 0 test/passing/tests/exp_grouping.ml.err | 0 test/passing/tests/extensions-indent.ml.err | 0 test/passing/tests/extensions-indent.mli.err | 0 .../tests/function_indent-never.ml.err | 0 test/passing/tests/function_indent.ml.err | 0 .../indicate_multiline_delimiters-cosl.ml.err | 0 test/passing/tests/invalid_docstrings.mli.err | 0 test/passing/tests/ite-fit_or_vertical.ml.err | 0 .../tests/ite-fit_or_vertical_closing.ml.err | 0 .../ite-fit_or_vertical_no_indicate.ml.err | 0 test/passing/tests/ite-kr.ml.err | 0 test/passing/tests/ite-kr_closing.ml.err | 0 .../passing/tests/ite-kw_first_closing.ml.err | 0 test/passing/tests/ite-vertical.ml.err | 0 test/passing/tests/js_source.ml | 14 + test/passing/tests/js_source.ml.ocp | 10 +- test/passing/tests/js_source.ml.ref | 18 +- .../tests/let_binding-in_indent.ml.err | 0 test/passing/tests/let_binding-indent.ml.err | 0 .../tests/let_binding_spacing-sparse.ml.err | 0 test/passing/tests/match_indent-never.ml.err | 0 test/passing/tests/match_indent.ml.err | 0 .../tests/module_item_spacing-preserve.ml.err | 0 .../passing/tests/module_item_spacing.mli.err | 0 .../open-closing-on-separate-line.ml.err | 0 .../tests/parens_tuple_patterns.ml.err | 0 test/passing/tests/sequence-preserve.ml.err | 0 test/passing/tests/sequence-preserve.ml.ref | 5 +- test/passing/tests/sequence.ml | 1 - test/passing/tests/sequence.ml.err | 0 test/passing/tests/sequence.ml.opts | 2 +- test/passing/tests/sequence.ml.ref | 5 +- test/passing/tests/source.ml.err | 2 +- test/passing/tests/source.ml.ref | 81 ++-- test/passing/tests/str_value.ml.err | 0 test/passing/tests/try_with_or_pattern.ml.err | 0 test/passing/tests/types-indent.ml.err | 0 test/passing/tests/wrap_comments.ml | 78 ++++ test/passing/tests/wrap_comments.ml.err | 20 +- test/passing/tests/wrap_comments.ml.ref | 127 +++-- 85 files changed, 1162 insertions(+), 427 deletions(-) delete mode 100644 test/passing/tests/break_before_in-auto.ml.err delete mode 100644 test/passing/tests/break_before_in.ml.err delete mode 100644 test/passing/tests/break_fun_decl-smart.ml.err create mode 100644 test/passing/tests/break_separators-after.ml.err create mode 100644 test/passing/tests/break_separators-before_docked.ml.err create mode 100644 test/passing/tests/break_separators.ml.err delete mode 100644 test/passing/tests/break_sequence_before.ml.err delete mode 100644 test/passing/tests/break_string_literals.ml.err delete mode 100644 test/passing/tests/break_struct.ml.err delete mode 100644 test/passing/tests/cases_exp_grouping.ml.err create mode 100644 test/passing/tests/comments-no-wrap.ml.err create mode 100644 test/passing/tests/comments-no-wrap.ml.opts create mode 100644 test/passing/tests/comments-no-wrap.ml.ref delete mode 100644 test/passing/tests/disambiguate.ml.err delete mode 100644 test/passing/tests/exp_grouping-parens.ml.err delete mode 100644 test/passing/tests/exp_grouping.ml.err delete mode 100644 test/passing/tests/extensions-indent.ml.err delete mode 100644 test/passing/tests/extensions-indent.mli.err delete mode 100644 test/passing/tests/function_indent-never.ml.err delete mode 100644 test/passing/tests/function_indent.ml.err delete mode 100644 test/passing/tests/indicate_multiline_delimiters-cosl.ml.err delete mode 100644 test/passing/tests/invalid_docstrings.mli.err delete mode 100644 test/passing/tests/ite-fit_or_vertical.ml.err delete mode 100644 test/passing/tests/ite-fit_or_vertical_closing.ml.err delete mode 100644 test/passing/tests/ite-fit_or_vertical_no_indicate.ml.err delete mode 100644 test/passing/tests/ite-kr.ml.err delete mode 100644 test/passing/tests/ite-kr_closing.ml.err delete mode 100644 test/passing/tests/ite-kw_first_closing.ml.err delete mode 100644 test/passing/tests/ite-vertical.ml.err delete mode 100644 test/passing/tests/let_binding-in_indent.ml.err delete mode 100644 test/passing/tests/let_binding-indent.ml.err delete mode 100644 test/passing/tests/let_binding_spacing-sparse.ml.err delete mode 100644 test/passing/tests/match_indent-never.ml.err delete mode 100644 test/passing/tests/match_indent.ml.err delete mode 100644 test/passing/tests/module_item_spacing-preserve.ml.err delete mode 100644 test/passing/tests/module_item_spacing.mli.err delete mode 100644 test/passing/tests/open-closing-on-separate-line.ml.err delete mode 100644 test/passing/tests/parens_tuple_patterns.ml.err delete mode 100644 test/passing/tests/sequence-preserve.ml.err delete mode 100644 test/passing/tests/sequence.ml.err delete mode 100644 test/passing/tests/str_value.ml.err delete mode 100644 test/passing/tests/try_with_or_pattern.ml.err delete mode 100644 test/passing/tests/types-indent.ml.err diff --git a/CHANGES.md b/CHANGES.md index 5949892780..7132b13140 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,7 @@ profile. This started with version 0.26.0. ### Changed +- \* Consistent formatting of comments (#2371, @Julow) - Documentation comments are now formatted by default (#2390, @Julow) Use the option `parse-docstrings = false` to disable. - \* Janestreet profile: do not break `fun _ -> function` (#2460, @tdelvecchio-jsc) diff --git a/lib/Cmt.ml b/lib/Cmt.ml index ad66026736..5798f51f09 100644 --- a/lib/Cmt.ml +++ b/lib/Cmt.ml @@ -82,40 +82,118 @@ let pp_error fs {kind; cmt_kind} = formatting using the option --no-parse-docstrings.\n\ %!" ) -module T_no_loc = struct - include T - - let compare = - Comparable.lexicographic [Comparable.lift String.compare ~f:txt] -end - -type loc = t - -module Comparator_no_loc = struct - type t = loc - - include Comparator.Make (T_no_loc) -end - type pos = Before | Within | After -let unindent_lines ~offset first_line tl_lines = - (* The indentation of the first line must account for the location of the - comment opening *) - let fl_spaces = - Option.value ~default:0 (String.indent_of_line first_line) - in - let fl_indent = fl_spaces + offset in - let min_indent = - List.fold_left ~init:fl_indent +type decoded_kind = + | Verbatim of string + | Doc of string + | Normal of string + | Code of string + | Asterisk_prefixed of string list + +type decoded = {prefix: string; suffix: string; kind: decoded_kind} + +(** [~content_offset] indicates at which column the body of the comment + starts (1-indexed). [~max_idnent] indicates the maximum amount of + indentation to trim. *) +let unindent_lines ?(max_indent = Stdlib.max_int) ~content_offset first_line + tl_lines = + let tl_indent = + List.fold_left ~init:max_indent ~f:(fun acc s -> Option.value_map ~default:acc ~f:(min acc) (String.indent_of_line s) ) tl_lines in - (* Completely trim the first line *) - String.drop_prefix first_line fl_spaces + (* The indentation of the first line must account for the location of the + comment opening. Don't account for the first line if it's empty. + [fl_trim] is the number of characters to remove from the first line. *) + let fl_trim, fl_indent = + match String.indent_of_line first_line with + | Some i -> + (max 0 (min i (tl_indent - content_offset)), i + content_offset - 1) + | None -> (String.length first_line, max_indent) + in + let min_indent = min tl_indent fl_indent in + let first_line = String.drop_prefix first_line fl_trim in + first_line :: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines -let unindent_lines ~offset = function +let unindent_lines ?max_indent ~content_offset txt = + match String.split ~on:'\n' txt with | [] -> [] - | hd :: tl -> unindent_lines ~offset hd tl + | hd :: tl -> unindent_lines ?max_indent ~content_offset hd tl + +let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace + +let split_asterisk_prefixed = + let prefix = "*" in + let drop_prefix s = String.drop_prefix s (String.length prefix) in + let rec lines_are_asterisk_prefixed = function + | [] -> true + (* Allow the last line to be empty *) + | [last] when is_all_whitespace last -> true + | hd :: tl -> + String.is_prefix hd ~prefix && lines_are_asterisk_prefixed tl + in + function + (* Check whether the second line is not empty to avoid matching a comment + with no asterisks. *) + | fst_line :: (snd_line :: _ as tl) + when lines_are_asterisk_prefixed tl && not (is_all_whitespace snd_line) + -> + Some (fst_line :: List.map tl ~f:drop_prefix) + | _ -> None + +let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind} + +let decode_comment ~parse_comments_as_doc txt loc = + let txt = + (* Windows compatibility *) + let f = function '\r' -> false | _ -> true in + String.filter txt ~f + in + let opn_offset = + let {Lexing.pos_cnum; pos_bol; _} = loc.Location.loc_start in + pos_cnum - pos_bol + 1 + in + if String.length txt >= 2 then + match txt.[0] with + | '$' when not (Char.is_whitespace txt.[1]) -> mk (Verbatim txt) + | '$' -> + let dollar_suf = Char.equal txt.[String.length txt - 1] '$' in + let suffix = if dollar_suf then "$" else "" in + let code = + let len = String.length txt - if dollar_suf then 2 else 1 in + String.sub ~pos:1 ~len txt + in + mk ~prefix:"$" ~suffix (Code code) + | '=' -> mk (Verbatim txt) + | _ when is_all_whitespace txt -> + mk (Verbatim " ") (* Make sure not to format to [(**)]. *) + | _ when parse_comments_as_doc -> mk (Doc txt) + | _ -> ( + let lines = + let content_offset = opn_offset + 2 in + unindent_lines ~content_offset txt + in + match split_asterisk_prefixed lines with + | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines) + | None -> mk (Normal txt) ) + else + match txt with + (* "(**)" is not parsed as a docstring but as a regular comment + containing '*' and would be rewritten as "(***)" *) + | "*" when Location.width loc = 4 -> mk (Verbatim "") + | ("*" | "$") as txt -> mk (Verbatim txt) + | "\n" | " " -> mk (Verbatim " ") + | _ -> mk (Normal txt) + +let decode_docstring _loc = function + | "" -> mk (Verbatim "") + | ("*" | "$") as txt -> mk (Verbatim txt) + | "\n" | " " -> mk (Verbatim " ") + | txt -> mk ~prefix:"*" (Doc txt) + +let decode ~parse_comments_as_doc = function + | Comment {txt; loc} -> decode_comment ~parse_comments_as_doc txt loc + | Docstring {txt; loc} -> decode_docstring loc txt diff --git a/lib/Cmt.mli b/lib/Cmt.mli index 8782f265b0..15ba9b8d86 100644 --- a/lib/Cmt.mli +++ b/lib/Cmt.mli @@ -33,14 +33,19 @@ val pp_error : Format.formatter -> error -> unit type pos = Before | Within | After -type loc = t - -module Comparator_no_loc : sig - type t = loc - - include Comparator.S with type t := t -end - -val unindent_lines : offset:int -> string list -> string list -(** Detect and remove the baseline indentation of a comment or a code block. - [offset] is the column number at which the first line starts. *) +type decoded_kind = + | Verbatim of string (** Original content. *) + | Doc of string (** Original content. *) + | Normal of string + (** Original content with indentation trimmed. Trailing spaces are not + removed. *) + | Code of string (** Source code with indentation removed. *) + | Asterisk_prefixed of string list + (** Line splitted with asterisks removed. *) + +type decoded = + { prefix: string (** Just after the opening. *) + ; suffix: string (** Just before the closing. *) + ; kind: decoded_kind } + +val decode : parse_comments_as_doc:bool -> t -> decoded diff --git a/lib/Cmts.ml b/lib/Cmts.ml index fce91b6465..72bbca00a8 100644 --- a/lib/Cmts.ml +++ b/lib/Cmts.ml @@ -448,7 +448,7 @@ let find_cmts ?(filter = Fn.const true) t pos loc = update_cmts t pos ~f:(Map.set ~key:loc ~data:not_picked) ; picked ) -let break_comment_group source margin a b = +let break_comment_group source a b = let a = Cmt.loc a and b = Cmt.loc b in let vertical_align = Location.line_difference a b = 1 && Location.compare_start_col a b = 0 @@ -459,191 +459,148 @@ let break_comment_group source margin a b = (Source.tokens_between source a.loc_end b.loc_start ~filter:(function _ -> true) ) in - not - ( (Location.is_single_line a margin && Location.is_single_line b margin) - && (vertical_align || horizontal_align) ) + not (vertical_align || horizontal_align) -module Asterisk_prefixed = struct - let split txt {Location.loc_start; _} = - let len = Position.column loc_start + 3 in - let pat = - String.Search_pattern.create - (String.init len ~f:(function - | 0 -> '\n' - | n when n < len - 1 -> ' ' - | _ -> '*' ) ) +let is_only_whitespaces s = String.for_all s ~f:Char.is_whitespace + +module Wrapped = struct + let fmt ~pro ~epi text = + let open Fmt in + assert (not (String.is_empty text)) ; + let prefix = if String.starts_with_whitespace text then " " else "" + and suffix = if String.ends_with_whitespace text then " " else "" in + let fmt_line line = + let words = + List.filter ~f:(Fn.non String.is_empty) + (String.split_on_chars line + ~on:['\t'; '\n'; '\011'; '\012'; '\r'; ' '] ) + in + list words "@ " str in - let rec split_ pos = - match String.Search_pattern.index pat ~pos ~in_:txt with - | Some 0 -> "" :: split_ len - | Some idx -> String.sub txt ~pos ~len:(idx - pos) :: split_ (idx + len) - | _ -> - let drop = function ' ' | '\t' -> true | _ -> false in - let line = String.rstrip ~drop (String.drop_prefix txt pos) in - if String.is_empty line then [" "] - else if Char.equal line.[String.length line - 1] '\n' then - [String.drop_suffix line 1; ""] - else if Char.is_whitespace txt.[String.length txt - 1] then - [line ^ " "] - else [line] + let lines = + List.remove_consecutive_duplicates + ~equal:(fun x y -> String.is_empty x && String.is_empty y) + (String.split (String.rstrip text) ~on:'\n') in - split_ 0 + let groups = + List.group lines ~break:(fun _ y -> is_only_whitespaces y) + in + pro $ str prefix + $ hovbox 0 + (list_fl groups (fun ~first ~last:last_group group -> + let group = List.filter group ~f:(Fn.non is_only_whitespaces) in + fmt_if (not first) "\n@\n" + $ hovbox 0 + (list_fl group (fun ~first ~last x -> + fmt_if (not first) "@ " $ fmt_line x + $ fmt_if_k (last_group && last) (str suffix $ epi) ) ) ) + ) +end - let fmt ~opn lines = - let open Fmt in - vbox 1 - ( opn - $ list_fl lines (fun ~first:_ ~last line -> - match line with - | "" when last -> fmt ")" - | _ -> str line $ fmt_or last "*)" "@,*" ) ) +module Asterisk_prefixed = struct + open Fmt + + let fmt_line ~first:_ ~last s = + if last && is_only_whitespaces s then fmt "@," else fmt "@,*" $ str s + + let fmt ~pro ~epi = function + | hd :: tl -> vbox 1 (pro $ str hd $ list_fl tl fmt_line $ epi) + | [] -> noop end module Unwrapped = struct - let fmt_multiline_cmt ?epi ~offset ~starts_with_sp lines = - let open Fmt in - let is_white_line s = String.for_all s ~f:Char.is_whitespace in - let unindented = Cmt.unindent_lines ~offset lines in - let fmt_line ~first ~last:_ s = - let sep, sp = - if is_white_line s then (str "\n", noop) - else (fmt "@;<1000 0>", fmt_if starts_with_sp " ") - in - fmt_if_k (not first) sep $ sp $ str (String.rstrip s) - in - vbox 0 ~name:"multiline" (list_fl unindented fmt_line $ fmt_opt epi) + open Fmt - let fmt ~opn ~offset s = - let open Fmt in - let is_sp = function ' ' | '\t' -> true | _ -> false in - match String.split_lines (String.rstrip s) with - | first_line :: _ :: _ as lines when not (String.is_empty first_line) -> - let epi = - (* Preserve position of closing but strip empty lines at the end *) - match String.rfindi s ~f:(fun _ c -> not (is_sp c)) with - | Some i when Char.( = ) s.[i] '\n' -> - break 1000 (-2) (* Break before closing *) - | Some i when i < String.length s - 1 -> - str " " (* Preserve a space at the end *) - | _ -> noop - in - (* Preserve the first level of indentation *) - let starts_with_sp = is_sp first_line.[0] in - opn $ fmt_multiline_cmt ~offset ~epi ~starts_with_sp lines $ str "*)" - | _ -> opn $ str s $ str "*)" + let fmt_line ~first:_ ~last:_ l = + (* The last line will be followed by the [epi]. *) + str "\n" $ str l + + (** [txt] contains trailing spaces and leading/trailing empty lines. *) + let fmt ~pro ~epi txt = + match String.split ~on:'\n' txt with + | hd :: tl -> + vbox 0 ~name:"unwrapped" (pro $ str hd $ list_fl tl fmt_line) $ epi + | [] -> noop end module Verbatim = struct - let fmt s (pos : Cmt.pos) = + let fmt ~pro ~epi s = let open Fmt in - fmt_if_k - (Poly.(pos = After) && String.contains s '\n') - (break_unless_newline 1000 0) - $ wrap "(*" "*)" @@ str s + pro $ str s $ epi end module Cinaps = struct open Fmt (** Comments enclosed in [(*$], [$*)] are formatted as code. *) - let fmt ~cls code = - hvbox 0 (fmt "(*$" $ hvbox (-1) (fmt "@;" $ code) $ fmt "@;" $ fmt cls) + let fmt ~pro ~epi ~fmt_code conf ~offset code = + match fmt_code conf ~offset ~set_margin:false code with + | Ok formatted -> + hvbox 0 (pro $ hvbox (-1) (fmt "@;" $ formatted) $ fmt "@;" $ epi) + | Error _ -> Verbatim.fmt ~pro ~epi code end -module Ocp_indent_compat = struct - let fmt ~fmt_code conf txt ~loc ~offset ~opn (pos : Cmt.pos) ~post = - let pre, doc, post = - let lines = String.split_lines txt in +module Doc = struct + let fmt ~pro ~epi ~fmt_code conf ~loc txt ~offset = + (* Whether the doc starts and ends with an empty line. *) + let pre_nl, trail_nl = + let lines = String.split ~on:'\n' txt in match lines with - | [] | [_] -> (false, txt, false) + | [] | [_] -> (false, false) | h :: _ -> - let pre = String.is_empty (String.strip h) in - let doc = if pre then String.lstrip txt else txt in - let doc = if Option.is_some post then String.rstrip doc else doc in - (pre, doc, Option.is_some post) + let l = List.last_exn lines in + (is_only_whitespaces h, is_only_whitespaces l) in - let parsed = Docstring.parse ~loc doc in - (* Disable warnings when parsing fails *) + let txt = if pre_nl then String.lstrip txt else txt in + let txt = if trail_nl then String.rstrip txt else txt in + let parsed = Docstring.parse ~loc txt in + (* Disable warnings when parsing of code blocks fails. *) let quiet = Conf_t.Elt.make true `Default in let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in - let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:doc ~offset parsed in + let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:txt ~offset parsed in let open Fmt in - fmt_if_k - (Poly.(pos = After) && String.contains txt '\n') - (break_unless_newline 1000 0) - $ opn - $ wrap_k (fmt_if pre "@;<1000 3>") (fmt_if post "@\n") doc - $ str "*)" + hvbox 2 + ( pro + $ fmt_if pre_nl "@;<1000 1>" + $ doc + $ fmt_if trail_nl "@;<1000 -2>" + $ epi ) end -let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos = - let loc = Cmt.loc cmt in - let offset = - let pos = loc.Location.loc_start in - pos.pos_cnum - pos.pos_bol + 2 - in - let mode = - match Cmt.txt cmt with - | "" -> `Verbatim "" - (* "(**)" is not parsed as a docstring but as a regular comment - containing '*' and would be rewritten as "(***)" *) - | "*" when Location.width loc = 4 -> `Verbatim "" - | "*" -> `Verbatim "*" - | "$" -> `Verbatim "$" - (* Qtest pragmas *) - | str when Char.(str.[0] = '$' && not (is_whitespace str.[1])) -> - `Verbatim str - | str when Char.equal str.[0] '$' -> ( - let dollar_suf = Char.equal str.[String.length str - 1] '$' in - let cls : Fmt.s = if dollar_suf then "$*)" else "*)" in - let len = String.length str - if dollar_suf then 2 else 1 in - let offset = offset + 1 in - let source = String.sub ~pos:1 ~len str in - match fmt_code conf ~offset ~set_margin:false source with - | Ok formatted -> `Code (formatted, cls) - | Error (`Msg _) -> `Unwrapped (str, None) ) - | txt when Char.equal txt.[0] '=' -> `Verbatim txt - | txt -> ( - let txt = - (* Windows compatibility *) - let filter = function '\r' -> false | _ -> true in - String.filter txt ~f:filter - in - match Asterisk_prefixed.split txt loc with - | [] | [""] -> impossible "not produced by split_asterisk_prefixed" - (* Comments like [(*\n*)] would be normalized as [(* *)] *) - | [""; ""] when conf.fmt_opts.ocp_indent_compat.v -> - `Unwrapped (txt, None) - | [""; ""] -> `Verbatim " " - | [text] when conf.fmt_opts.wrap_comments.v -> `Wrapped (text, "*)") - | [text; ""] when conf.fmt_opts.wrap_comments.v -> - `Wrapped (text, " *)") - | [_] -> `Unwrapped (txt, None) - | [_; ""] -> `Unwrapped (txt, Some `Ln) - | lines -> `Asterisk_prefixed lines ) - in +let fmt_cmt (conf : Conf.t) cmt ~fmt_code = let open Fmt in - let opn = if Cmt.is_docstring cmt then str "(**" else str "(*" in - match mode with - | `Verbatim x -> Verbatim.fmt x pos - | `Code (code, cls) -> Cinaps.fmt ~cls code - | `Wrapped (x, epi) -> opn $ fill_text x ~epi - | `Unwrapped (x, ln) when conf.fmt_opts.ocp_indent_compat.v -> - Ocp_indent_compat.fmt ~fmt_code conf x ~loc ~offset ~opn pos ~post:ln - | `Unwrapped (x, _) -> Unwrapped.fmt ~opn ~offset x - | `Asterisk_prefixed x -> Asterisk_prefixed.fmt ~opn x + let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in + let decoded = Cmt.decode ~parse_comments_as_doc cmt in + (* TODO: Offset should be computed from location. *) + let offset = 2 + String.length decoded.prefix in + let pro = str "(*" $ str decoded.prefix + and epi = str decoded.suffix $ str "*)" in + match decoded.kind with + | Verbatim txt -> Verbatim.fmt ~pro ~epi txt + | Doc txt -> + Doc.fmt ~pro ~epi ~fmt_code conf ~loc:(Cmt.loc cmt) txt ~offset + | Normal txt -> + if conf.fmt_opts.wrap_comments.v then Wrapped.fmt ~pro ~epi txt + else Unwrapped.fmt ~pro ~epi txt + | Code code -> Cinaps.fmt ~pro ~epi ~fmt_code conf ~offset code + | Asterisk_prefixed lines -> Asterisk_prefixed.fmt ~pro ~epi lines let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos = let open Fmt in - let groups = - List.group cmts - ~break:(break_comment_group t.source conf.fmt_opts.margin.v) - in + let groups = List.group cmts ~break:(break_comment_group t.source) in vbox 0 ~name:"cmts" (list_pn groups (fun ~prev:_ group ~next -> ( match group with | [] -> impossible "previous match" - | [cmt] -> fmt_cmt conf cmt ~fmt_code pos + | [cmt] -> + let break = + fmt_if_k + ( conf.fmt_opts.ocp_indent_compat.v + && Poly.(pos = Cmt.After) + && String.contains (Cmt.txt cmt) '\n' ) + (break_unless_newline 1000 0) + in + break $ fmt_cmt conf cmt ~fmt_code | group -> list group "@;<1000 0>" (fun cmt -> wrap "(*" "*)" (str (Cmt.txt cmt)) ) ) @@ -771,17 +728,3 @@ let remaining_comments t = let remaining_before t loc = Map.find_multi t.cmts_before loc let remaining_locs t = Set.to_list t.remaining - -let is_docstring (conf : Conf.t) cmt = - let might_be_docstring cmt = - match Cmt.txt cmt with - | "" | "*" -> false - | txt -> not (Char.equal txt.[0] '$') - in - (* In ocp_indent_compat mode, comments are parsed like docstrings. *) - if - conf.fmt_opts.parse_docstrings.v - && ( Cmt.is_docstring cmt - || (conf.fmt_opts.ocp_indent_compat.v && might_be_docstring cmt) ) - then Either.First cmt - else Either.Second cmt diff --git a/lib/Cmts.mli b/lib/Cmts.mli index be1a9da4bb..a5c04848fd 100644 --- a/lib/Cmts.mli +++ b/lib/Cmts.mli @@ -121,10 +121,3 @@ type layout_cache_key = val preserve : cache_key:layout_cache_key -> (unit -> Fmt.t) -> t -> string (** [preserve f t] formats like [f ()] but returns a string and does not consume comments from [t]. *) - -val is_docstring : Conf.t -> Cmt.t -> (Cmt.t, Cmt.t) Either.t -(** [is_docstring conf cmt] returns: - - - [First c] when [cmt] is a docstring, where [c] is its content stripped - of the leading [*]; - - [Second c] when [cmt] is a regular comment, where [c] is its content. *) diff --git a/lib/Fmt.ml b/lib/Fmt.ml index aef6cf0aab..523d3ed1e9 100644 --- a/lib/Fmt.ml +++ b/lib/Fmt.ml @@ -289,39 +289,3 @@ and vbox_if ?name cnd n = wrap_if_k cnd (open_vbox ?name n) close_box and hvbox_if ?name cnd n = wrap_if_k cnd (open_hvbox ?name n) close_box and hovbox_if ?name cnd n = wrap_if_k cnd (open_hovbox ?name n) close_box - -(** Text filling --------------------------------------------------------*) - -let fill_text ?(epi = "") text = - assert (not (String.is_empty text)) ; - let fmt_line line = - let words = - List.filter ~f:(Fn.non String.is_empty) - (String.split_on_chars line - ~on:['\t'; '\n'; '\011'; '\012'; '\r'; ' '] ) - in - list words "@ " str - in - let lines = - List.remove_consecutive_duplicates - ~equal:(fun x y -> String.is_empty x && String.is_empty y) - (String.split (String.rstrip text) ~on:'\n') - in - let pro = if String.starts_with_whitespace text then " " else "" in - let epi = - if String.length text > 1 && String.ends_with_whitespace text then - " " ^ epi - else epi - in - str pro - $ hvbox 0 - (hovbox 0 - ( list_pn lines (fun ~prev:_ curr ~next -> - fmt_line curr - $ - match next with - | Some str when String.for_all str ~f:Char.is_whitespace -> - close_box $ fmt "\n@," $ open_hovbox 0 - | Some _ when not (String.is_empty curr) -> fmt "@ " - | _ -> noop ) - $ str epi ) ) diff --git a/lib/Fmt.mli b/lib/Fmt.mli index ff607bbf0e..af6e2040a6 100644 --- a/lib/Fmt.mli +++ b/lib/Fmt.mli @@ -218,8 +218,3 @@ val hvbox_if : ?name:string -> bool -> int -> t -> t val hovbox_if : ?name:string -> bool -> int -> t -> t (** Conditionally wrap a format thunk with an hovbox with specified indentation. *) - -(** Text filling --------------------------------------------------------*) - -val fill_text : ?epi:string -> string -> t -(** Format a non-empty string as filled text wrapped at the margin. *) diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml index c7634794de..3355c7670e 100644 --- a/lib/Normalize_extended_ast.ml +++ b/lib/Normalize_extended_ast.ml @@ -38,26 +38,27 @@ let dedup_cmts fragment ast comments = in Set.(to_list (diff (of_list (module Cmt) comments) (of_ast ast))) -let normalize_comments dedup fmt comments = - let comments = dedup comments in - List.sort comments ~compare:(fun a b -> - Migrate_ast.Location.compare (Cmt.loc a) (Cmt.loc b) ) - |> List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," (Cmt.txt cmt)) +let normalize_comments ~normalize_cmt dedup fmt comments = + dedup comments + |> List.sort ~compare:(fun a b -> + Migrate_ast.Location.compare (Cmt.loc a) (Cmt.loc b) ) + |> List.iter ~f:(fun cmt -> Format.fprintf fmt "%s," (normalize_cmt cmt)) -let normalize_parse_result ast_kind ast comments = +let normalize_parse_result ~normalize_cmt ast_kind ast comments = Format.asprintf "AST,%a,COMMENTS,[%a]" (Printast.ast ast_kind) ast - (normalize_comments (dedup_cmts ast_kind ast)) + (normalize_comments ~normalize_cmt (dedup_cmts ast_kind ast)) comments -let normalize_code conf (m : Ast_mapper.mapper) txt = +let normalize_code ~normalize_cmt conf (m : Ast_mapper.mapper) txt = let input_name = "" in + let normalize_cmt = normalize_cmt conf in match Parse_with_comments.parse_toplevel conf ~input_name ~source:txt with | First {ast; comments; _} -> - normalize_parse_result Use_file + normalize_parse_result ~normalize_cmt Use_file (List.map ~f:(m.toplevel_phrase m) ast) comments | Second {ast; comments; _} -> - normalize_parse_result Repl_file + normalize_parse_result ~normalize_cmt Repl_file (List.map ~f:(m.repl_phrase m) ast) comments | exception _ -> txt @@ -68,7 +69,7 @@ let docstring (c : Conf.t) = let sort_attributes : attributes -> attributes = List.sort ~compare:Poly.compare -let make_mapper conf ~ignore_doc_comments = +let make_mapper ~ignore_doc_comments ~normalize_doc = let open Ast_helper in (* remove locations *) let location _ _ = Location.none in @@ -86,11 +87,7 @@ let make_mapper conf ~ignore_doc_comments = , [] ) ; _ } as pstr ) ] when Ast.Attr.is_doc attr -> - let normalize_code = - (* Indentation is already stripped by odoc-parser. *) - normalize_code conf m - in - let doc' = docstring conf ~normalize_code doc in + let doc' = normalize_doc doc in Ast_mapper.default_mapper.attribute m { attr with attr_payload= @@ -154,12 +151,67 @@ let make_mapper conf ~ignore_doc_comments = ; expr ; typ } +let normalize_cmt (conf : Conf.t) = + let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in + object (self) + method cmt c = + let decoded = Cmt.decode ~parse_comments_as_doc c in + match decoded.Cmt.kind with + | Verbatim txt -> txt + | Doc txt -> self#doc txt + | Normal txt -> Docstring.normalize_text txt + | Code txt -> self#code txt + | Asterisk_prefixed lines -> + String.concat ~sep:" " (List.map ~f:Docstring.normalize_text lines) + + method doc d = docstring conf ~normalize_code:self#code d + + method code c = + let mapper = + make_mapper ~ignore_doc_comments:false ~normalize_doc:self#doc + in + let normalize_cmt _conf cmt = self#cmt cmt in + normalize_code ~normalize_cmt conf mapper c + end + let ast fragment ~ignore_doc_comments c = - map fragment (make_mapper c ~ignore_doc_comments) + let normalize_cmt = normalize_cmt c in + map fragment + (make_mapper ~ignore_doc_comments ~normalize_doc:normalize_cmt#doc) + +module Normalized_cmt = struct + type t = + { cmt_kind: [`Comment | `Doc_comment] + ; norm: string + ; orig: Cmt.t (** Not compared. *) } + + let compare a b = Poly.compare (a.cmt_kind, a.norm) (b.cmt_kind, b.norm) + + let of_cmt normalize_cmt orig = + let cmt_kind = + if Cmt.is_docstring orig then `Doc_comment else `Comment + in + let norm = normalize_cmt orig in + {cmt_kind; norm; orig} + + let dropped {cmt_kind; orig; _} = {Cmt.kind= `Dropped orig; cmt_kind} + + let added {cmt_kind; orig; _} = {Cmt.kind= `Added orig; cmt_kind} -let diff ~f ~cmt_kind x y = - let dropped x = {Cmt.kind= `Dropped x; cmt_kind} in - let added x = {Cmt.kind= `Added x; cmt_kind} in + let sexp_of_t _ = Sexp.Atom "Normalized_cmt.t" + + module Comparator = struct + type nonrec t = t + + include Comparator.Make (struct + type nonrec t = t + + let compare, sexp_of_t = (compare, sexp_of_t) + end) + end +end + +let diff ~f x y = (*= [symmetric_diff x y] returns a sequence of changes between [x] and [y]: - [First k] means [k] is in [x] but not [y] - [Second k] means [k] is in [y] but not [x] *) @@ -167,47 +219,19 @@ let diff ~f ~cmt_kind x y = |> Sequence.to_list (*= - [First _] is reported as a comment dropped - [Second _] is reported as a comment added *) - |> List.map ~f:(Either.value_map ~first:dropped ~second:added) + |> List.map + ~f: + (Either.value_map ~first:Normalized_cmt.dropped + ~second:Normalized_cmt.added ) |> function [] -> Ok () | errors -> Error errors -let diff_docstrings c x y = - let mapper = make_mapper c ~ignore_doc_comments:false in - let docstring cmt = - let normalize_code = normalize_code c mapper in - docstring c ~normalize_code (Cmt.txt cmt) - in - let norm z = - let f cmt = Cmt.create_docstring (docstring cmt) (Cmt.loc cmt) in - Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z) - in - diff ~f:norm ~cmt_kind:`Doc_comment x y - let diff_cmts (conf : Conf.t) x y = - let mapper = make_mapper conf ~ignore_doc_comments:false in - let normalize_code = normalize_code conf mapper in - let norm z = - let norm_non_code cmt = - Cmt.create_comment - (Docstring.normalize_text (Cmt.txt cmt)) - (Cmt.loc cmt) - in - let f z = - match Cmt.txt z with - | "" | "$" -> norm_non_code z - | str -> - if Char.equal str.[0] '$' then - let chars_removed = - if Char.equal str.[String.length str - 1] '$' then 2 else 1 - in - let len = String.length str - chars_removed in - let source = String.sub ~pos:1 ~len str in - let loc = Cmt.loc z in - Cmt.create_comment (normalize_code source) loc - else norm_non_code z - in - Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z) + let normalize = normalize_cmt conf in + let f z = + let f = Normalized_cmt.of_cmt normalize#cmt in + Set.of_list (module Normalized_cmt.Comparator) (List.map ~f z) in - diff ~f:norm ~cmt_kind:`Comment x y + diff ~f x y let equal fragment ~ignore_doc_comments c ast1 ast2 = let map = ast fragment c ~ignore_doc_comments in diff --git a/lib/Normalize_extended_ast.mli b/lib/Normalize_extended_ast.mli index 4a996c2ba8..59f4644278 100644 --- a/lib/Normalize_extended_ast.mli +++ b/lib/Normalize_extended_ast.mli @@ -16,10 +16,6 @@ val equal : 'a Extended_ast.t -> ignore_doc_comments:bool -> Conf.t -> 'a -> 'a -> bool (** Compare fragments for equality up to normalization. *) -val diff_docstrings : - Conf.t -> Cmt.t list -> Cmt.t list -> (unit, Cmt.error list) Result.t -(** Difference between two lists of doc comments. *) - val diff_cmts : Conf.t -> Cmt.t list -> Cmt.t list -> (unit, Cmt.error list) Result.t (** Difference between two lists of comments. *) diff --git a/lib/Translation_unit.ml b/lib/Translation_unit.ml index 2013919c74..160eae85de 100644 --- a/lib/Translation_unit.ml +++ b/lib/Translation_unit.ml @@ -224,11 +224,7 @@ let check_comments (conf : Conf.t) cmts ~old:t_old ~new_:t_new = if conf.opr_opts.comment_check.v then let errors = let* () = check_remaining_comments cmts in - let split_cmts = List.partition_map ~f:(Cmts.is_docstring conf) in - let old_docs, old_cmts = split_cmts t_old.comments in - let new_docs, new_cmts = split_cmts t_new.comments in - let* () = Normalize_extended_ast.diff_cmts conf old_cmts new_cmts in - Normalize_extended_ast.diff_docstrings conf old_docs new_docs + Normalize_extended_ast.diff_cmts conf t_old.comments t_new.comments in match errors with | Ok () -> () diff --git a/test/passing/dune.inc b/test/passing/dune.inc index 0db3020328..8b0d575cbe 100644 --- a/test/passing/dune.inc +++ b/test/passing/dune.inc @@ -1130,6 +1130,24 @@ (package ocamlformat) (action (diff tests/comment_sparse.ml.err comment_sparse.ml.stderr))) +(rule + (deps tests/.ocamlformat ) + (package ocamlformat) + (action + (with-stdout-to comments-no-wrap.ml.stdout + (with-stderr-to comments-no-wrap.ml.stderr + (run %{bin:ocamlformat} --margin-check --no-wrap-comments --max-iter=3 %{dep:tests/comments.ml}))))) + +(rule + (alias runtest) + (package ocamlformat) + (action (diff tests/comments-no-wrap.ml.ref comments-no-wrap.ml.stdout))) + +(rule + (alias runtest) + (package ocamlformat) + (action (diff tests/comments-no-wrap.ml.err comments-no-wrap.ml.stderr))) + (rule (deps tests/.ocamlformat ) (package ocamlformat) @@ -4774,7 +4792,7 @@ (action (with-stdout-to sequence.ml.stdout (with-stderr-to sequence.ml.stderr - (run %{bin:ocamlformat} --margin-check --sequence-blank-line=compact --max-iter=3 %{dep:tests/sequence.ml}))))) + (run %{bin:ocamlformat} --margin-check --sequence-blank-line=compact %{dep:tests/sequence.ml}))))) (rule (alias runtest) diff --git a/test/passing/tests/break_before_in-auto.ml.err b/test/passing/tests/break_before_in-auto.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/break_before_in.ml.err b/test/passing/tests/break_before_in.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/break_fun_decl-smart.ml.err b/test/passing/tests/break_fun_decl-smart.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/break_separators-after.ml.err b/test/passing/tests/break_separators-after.ml.err new file mode 100644 index 0000000000..7de3e58d2b --- /dev/null +++ b/test/passing/tests/break_separators-after.ml.err @@ -0,0 +1 @@ +Warning: tests/break_separators.ml:289 exceeds the margin diff --git a/test/passing/tests/break_separators-after.ml.ref b/test/passing/tests/break_separators-after.ml.ref index 5353f8eef8..a3d77ee546 100644 --- a/test/passing/tests/break_separators-after.ml.ref +++ b/test/passing/tests/break_separators-after.ml.ref @@ -287,8 +287,7 @@ let foooooooooooo = let foooooooooooo = { foooooooooooooo with - (* foooooooooooooooo fooooooooooooooooooooooooo - foooooooooooooooooooooo *) + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *) fooooooooooooooooooooooooooooo= fooooooooooooo; fooooooooooooo= foooooooooooooo } diff --git a/test/passing/tests/break_separators-after_docked.ml.err b/test/passing/tests/break_separators-after_docked.ml.err index 2ccd970c7d..fd77cc8910 100644 --- a/test/passing/tests/break_separators-after_docked.ml.err +++ b/test/passing/tests/break_separators-after_docked.ml.err @@ -1 +1,2 @@ -Warning: tests/break_separators.ml:335 exceeds the margin +Warning: tests/break_separators.ml:324 exceeds the margin +Warning: tests/break_separators.ml:334 exceeds the margin diff --git a/test/passing/tests/break_separators-after_docked.ml.ref b/test/passing/tests/break_separators-after_docked.ml.ref index ae435ee3a2..325930a4f4 100644 --- a/test/passing/tests/break_separators-after_docked.ml.ref +++ b/test/passing/tests/break_separators-after_docked.ml.ref @@ -322,8 +322,7 @@ let foooooooooooo = let foooooooooooo = { foooooooooooooo with - (* foooooooooooooooo fooooooooooooooooooooooooo - foooooooooooooooooooooo *) + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *) fooooooooooooooooooooooooooooo= fooooooooooooo; fooooooooooooo= foooooooooooooo; } diff --git a/test/passing/tests/break_separators-before_docked.ml.err b/test/passing/tests/break_separators-before_docked.ml.err new file mode 100644 index 0000000000..43e94ebf2b --- /dev/null +++ b/test/passing/tests/break_separators-before_docked.ml.err @@ -0,0 +1 @@ +Warning: tests/break_separators.ml:324 exceeds the margin diff --git a/test/passing/tests/break_separators-before_docked.ml.ref b/test/passing/tests/break_separators-before_docked.ml.ref index 7d0f75e25e..63a5e062e7 100644 --- a/test/passing/tests/break_separators-before_docked.ml.ref +++ b/test/passing/tests/break_separators-before_docked.ml.ref @@ -322,8 +322,7 @@ let foooooooooooo = let foooooooooooo = { foooooooooooooo with - (* foooooooooooooooo fooooooooooooooooooooooooo - foooooooooooooooooooooo *) + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *) fooooooooooooooooooooooooooooo= fooooooooooooo ; fooooooooooooo= foooooooooooooo } diff --git a/test/passing/tests/break_separators.ml b/test/passing/tests/break_separators.ml index 29a972901e..5d5af4f814 100644 --- a/test/passing/tests/break_separators.ml +++ b/test/passing/tests/break_separators.ml @@ -287,8 +287,7 @@ let foooooooooooo = let foooooooooooo = { foooooooooooooo with - (* foooooooooooooooo fooooooooooooooooooooooooo - foooooooooooooooooooooo *) + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *) fooooooooooooooooooooooooooooo= fooooooooooooo ; fooooooooooooo= foooooooooooooo } diff --git a/test/passing/tests/break_separators.ml.err b/test/passing/tests/break_separators.ml.err new file mode 100644 index 0000000000..7de3e58d2b --- /dev/null +++ b/test/passing/tests/break_separators.ml.err @@ -0,0 +1 @@ +Warning: tests/break_separators.ml:289 exceeds the margin diff --git a/test/passing/tests/break_sequence_before.ml.err b/test/passing/tests/break_sequence_before.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/break_string_literals.ml.err b/test/passing/tests/break_string_literals.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/break_struct.ml.err b/test/passing/tests/break_struct.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/cases_exp_grouping.ml.err b/test/passing/tests/cases_exp_grouping.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/cinaps.ml b/test/passing/tests/cinaps.ml index e5e14331be..34e45a43b0 100644 --- a/test/passing/tests/cinaps.ml +++ b/test/passing/tests/cinaps.ml @@ -15,6 +15,7 @@ let x = 1 (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) ["+"; "-"; "*"; "/"] *) + (*$*) let y = 2 @@ -35,6 +36,7 @@ let x = 1 (* foooooooo *) z $*) + (*$*) let foo = foo @@ -56,4 +58,24 @@ let foo = foo (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) ["+"; "-"; "*"; "/"] *) + +(*$*) + +(*$ + (* + x + *) +*) + +(*$*) + +(*$ + let _ = + [ x (* + *) + ; y + ] + ;; +*) + (*$*) diff --git a/test/passing/tests/cinaps.ml.err b/test/passing/tests/cinaps.ml.err index 6c128b0f94..bd76194c26 100644 --- a/test/passing/tests/cinaps.ml.err +++ b/test/passing/tests/cinaps.ml.err @@ -1 +1 @@ -Warning: tests/cinaps.ml:24 exceeds the margin +Warning: tests/cinaps.ml:25 exceeds the margin diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref index 71fc3755f2..4c1d150e85 100644 --- a/test/passing/tests/cinaps.ml.ref +++ b/test/passing/tests/cinaps.ml.ref @@ -15,6 +15,7 @@ let x = 1 (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) ["+"; "-"; "*"; "/"] *) + (*$*) let y = 2 @@ -37,6 +38,7 @@ let x = 1 (* foooooooo *) z $*) + (*$*) let foo = foo @@ -58,4 +60,13 @@ let foo = foo (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) ["+"; "-"; "*"; "/"] *) + +(*$*) + +(*$ (* x *) *) + +(*$*) + +(*$ let _ = [x (* *); y] *) + (*$*) diff --git a/test/passing/tests/comment_header.ml.ref b/test/passing/tests/comment_header.ml.ref index 116c600c55..6940cb8125 100644 --- a/test/passing/tests/comment_header.ml.ref +++ b/test/passing/tests/comment_header.ml.ref @@ -55,4 +55,4 @@ type typ = typ * * The source code of this test is empty: we just check the arguments * expansion. - * *) + *) diff --git a/test/passing/tests/comments-no-wrap.ml.err b/test/passing/tests/comments-no-wrap.ml.err new file mode 100644 index 0000000000..26769f21aa --- /dev/null +++ b/test/passing/tests/comments-no-wrap.ml.err @@ -0,0 +1,5 @@ +Warning: tests/comments.ml:186 exceeds the margin +Warning: tests/comments.ml:190 exceeds the margin +Warning: tests/comments.ml:248 exceeds the margin +Warning: tests/comments.ml:383 exceeds the margin +Warning: tests/comments.ml:415 exceeds the margin diff --git a/test/passing/tests/comments-no-wrap.ml.opts b/test/passing/tests/comments-no-wrap.ml.opts new file mode 100644 index 0000000000..4fa0ab82c2 --- /dev/null +++ b/test/passing/tests/comments-no-wrap.ml.opts @@ -0,0 +1,2 @@ +--no-wrap-comments +--max-iter=3 diff --git a/test/passing/tests/comments-no-wrap.ml.ref b/test/passing/tests/comments-no-wrap.ml.ref new file mode 100644 index 0000000000..92d042380c --- /dev/null +++ b/test/passing/tests/comments-no-wrap.ml.ref @@ -0,0 +1,437 @@ +(* *) + +(**) + +(* *) + +(*$*) +(*$ *) +(*$ *) + +let _ = f (*f*) a (*a*) ~b (*comment*) ~c:(*comment*) c' ?d ?e () + +let _ = + let _ = + f + (*comment*) + (let open M in + let x = x in + e ) + in + () + +let _ = ((*comment*) a (*comment*), b) + +let foo = function Blah ((* old *) x, y) -> () + +let foo = function Blah (x (* old *), y) -> () + +let foo = function Blah, (* old *) (x, y) -> () + +let foo = function Blah (x, y) (* old *) -> () + +let foo = function Blah, (x, y (* old *)) -> () + +let foo = function Blah, (x, (* old *) y) -> () + +let foo = function (x, y) (* old *), z -> () + +let _ = + if (* a0 *) b (* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) + +let _ = + if (* a1 *) b (* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) + +let _ = + if (* a2 *) B (* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) + +let _ = + if (* a3 *) B (* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *) +;; + +match x with +| true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +(* this comment should not change the formatting of the following case *) +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +;; + +try f x +with +(* this comment is intended to refer to the entire case below *) +| Caml.Not_found -> + () +;; + +match x with +(* this comment is intended to refer to the entire case below *) +| false -> () +;; + +match x with +| Aaaaaaaaaaaaaaaaaaaa +(* this comment is intended to refer to the case below *) + |Bbbbbbbbbbbbbbbbbbbb -> + () + +let _ = + (* this comment is intended to refer to the entire match below *) + match x with + | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> () + | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> () + +module type M = sig + val f (* A list of [name], [count] pairs. *) : (string * int) list -> int +end + +let _ = f ~f:(fun a b -> c) (* comment *) ~f:(fun a b -> c) + +let _ = f (fun x -> g h) (* comment *) ~f:(fun a b -> c) + +let _ = f (g h) (* comment *) ~f:(fun a b -> c) + +let _ = f (0 + 0 (* test *) + (1 * 1) (* test *)) + +let _ = f ((1 * 1) (* test *) + (0 + 0) (* test *)) + +let _ = match e with 3 (* test *) -> e | 3 (* test *) :: tail -> e + +let _ = if a then b :: c (* d *) else e + +let (b :: c (* d *)) = x + +module rec A = struct end + +(*test*) +and B = struct end + +module type T = sig + module rec A : sig end + + (*test*) + and B : sig end +end + +let f = (* comment *) function x -> x + +let foo x : z = (* comment *) y + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) <- + (*f*) + (*g*) + x + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] <- + (*f*) + (*g*) + x + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} <- + (*f*) + (*g*) + x + +let _ = (*a*) s (*b*).%{(*c*) i (*d*)} + +let _ = + (*a*) + s (*b*).%{(*c*) i (*d*)} <- + (*e*) + (*f*) + x + +type t = {a: int [@default a] (* comment *); b: flag} + +let () = + (* *) + + (* *) + () + +(* break when unicode sequence length measured in bytes but ¬ in code points *) + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb (* foo *) + | Bbbbbbbbbb (* foo *) + +let () = + xxxxxxxxxx + || (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +let () = + xxxxxxxxxx + land (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +let rec fooooooooooo = function + (*XX*) + | x :: t (*YY*) -> k + (* AA*) + | [ (*BB*) + (* CC *) + x + (* DD *) + ; (* EE *) + y + (* FF *) + (* GG *) ] + (* HH *) -> + k + (* AA*) + (*BB*) + (* CC *) + | x (* DD *) :: (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> + k + (* AA*) + (*BB*) + (* CC *) + | x + (* DD *) + (* XX *) + :: (* YY *) + (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> + k + (* AA *) + (* BB *) + | (module (* CC *) + (* DD *) F (* EE *) : (* FF *) M (* GG *) ) (* HH *) + :: (* II *) t + (* JJ *) + (* KK *) -> + foo + +let%map + (* __________________________________________________________________________________________ *) + _ = + () + +type t = < (* a *) + a: int [@atr] (* b *) ; b: int (* c *) > + +type t = < a: int (* a *) ; (* b *) .. (* c *) > + +type t = < (* a *) .. (* b *) > + +class type i = object + (* test *) + inherit oo +end + +class i = + object + (* test *) + inherit oo + end + +let _ = + try_with (fun () -> + (* comment before *) + match get () with + | None -> do_something () + | Some _ -> () (* do nothing *) ) + +let _ = try_with (fun () -> (* comment before *) + a ; b (* after b *) ) + +let _ = + match x with + | Some y -> ( + match y with None -> () | Some z -> incr z (* double some *) ) + | None -> () + +type prefix = + {sib_extend: int (** add more as needed *) (* extended sib index bit *)} + +type t = + | A (* A *) + (* | B *) + | C + +type t = + (* | B *) + | A + (* A *) + | C + +type t = + | A + (* A *) + (* | B *) + | C + +type foo = Alpha | Beta +[@@ocaml.warning "-37" (* Explanation of warning *)] + +type foo = + | Alpha______________________________ + | Beta_______________________________ +[@@ocaml.warning "-37" (* Explanation of warning *)] + +let y = + f + (* a *) + (* b *) + x + +module A (* A *) () (* B *) = (* C *) B + +let kk = (* foo *) (module A : T) + +let kk = (* foo *) (module A : T) + +let kk = (module A : T) (* foo *) + +let kk = (* foo *) (module A : T) (* foo *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *)) +(* after exp_pack *) +(* after exp *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *) : (* before S *) S (* after S *)) +(* after exp_pack *) +(* after exp *) + +let _ = assert (foo (bar + baz <= quux)) +(* this comment should stay attached to the preceding item *) + +let _ = foo + +let a = + [ b + (* *) + (* c *) ] + +let _ = + 1 + + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + - (* fooooooooooooo foooooooooooooooooooooo foooooooooooooooooooo *) + foooooooooooooo foooooooooooooo foooooooooooooooooo fooooooooo + % (* foooooooooooooooo foooooooooooo foooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + / (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr + * (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + $ (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + & (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + = (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + > (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + < (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + @ foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + ^ (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + || (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo + fooooooooooooooo + #= (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo + foooooooooooooooo fooooooooooooooo + +let _ = + ! + (*a*) + (*b*) + x + +let _ = + (*x*) + ! + (*a*) + (*b*) + x (*c*) y + +let _ = + f + ((*x*) + ! + (*a*) + (*b*) + x + (*c*) y ) + y + +type a = b (* a *) as (* b *) 'c (* c *) + +type t = + { (* comment before mutable *) + mutable + (* really long comment that doesn't fit on the same line as other stuff *) + x: + int } + +let _ = (x + y) [@attr] + z + +let _ = x ^ (y ^ z) [@attr] + +let _ = + () ; + (* indentation preserved + *) + () ; + (* indentation preserved + *) + () ; + (* indentation preserved + *) + () ; + (* indentation not preserved +*) + () diff --git a/test/passing/tests/comments.ml b/test/passing/tests/comments.ml index f6fa2146e7..eb247663d4 100644 --- a/test/passing/tests/comments.ml +++ b/test/passing/tests/comments.ml @@ -315,3 +315,18 @@ type t = { (* comment before mutable *) mutable let _ = (x + y) [@attr] + z let _ = x ^ (y ^ z) [@attr] + +let _ = + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation not preserved +*) + () diff --git a/test/passing/tests/comments.ml.ref b/test/passing/tests/comments.ml.ref index 548fdc173f..a443e4e6db 100644 --- a/test/passing/tests/comments.ml.ref +++ b/test/passing/tests/comments.ml.ref @@ -424,3 +424,14 @@ type t = let _ = (x + y) [@attr] + z let _ = x ^ (y ^ z) [@attr] + +let _ = + () ; + (* indentation preserved *) + () ; + (* indentation preserved *) + () ; + (* indentation preserved *) + () ; + (* indentation not preserved *) + () diff --git a/test/passing/tests/disambiguate.ml.err b/test/passing/tests/disambiguate.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/doc_comments-after.ml.err b/test/passing/tests/doc_comments-after.ml.err index dd738d90f3..71ec524f66 100644 --- a/test/passing/tests/doc_comments-after.ml.err +++ b/test/passing/tests/doc_comments-after.ml.err @@ -1 +1,4 @@ -Warning: tests/doc_comments.ml:301 exceeds the margin +Warning: tests/doc_comments.ml:268 exceeds the margin +Warning: tests/doc_comments.ml:269 exceeds the margin +Warning: tests/doc_comments.ml:270 exceeds the margin +Warning: tests/doc_comments.ml:299 exceeds the margin diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref index fdacc13e71..ad4ad77c2e 100644 --- a/test/passing/tests/doc_comments-after.ml.ref +++ b/test/passing/tests/doc_comments-after.ml.ref @@ -266,11 +266,9 @@ module A = struct end end -(* Same with get_pure, except that when we have both "x = t" and "y = t" - where t is a primed ident, * we add "x = y" to the result. This is crucial - for the normalizer, as it tend to drop "x = t" before * processing "y = - t". If we don't explicitly preserve "x = y", the normalizer cannot pick it - up *) +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, + * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before + * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) let _ = () (** Tags without text *) diff --git a/test/passing/tests/doc_comments-before-except-val.ml.err b/test/passing/tests/doc_comments-before-except-val.ml.err index dd738d90f3..71ec524f66 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.err +++ b/test/passing/tests/doc_comments-before-except-val.ml.err @@ -1 +1,4 @@ -Warning: tests/doc_comments.ml:301 exceeds the margin +Warning: tests/doc_comments.ml:268 exceeds the margin +Warning: tests/doc_comments.ml:269 exceeds the margin +Warning: tests/doc_comments.ml:270 exceeds the margin +Warning: tests/doc_comments.ml:299 exceeds the margin diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref index 59a6180c19..66cc7751a1 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.ref +++ b/test/passing/tests/doc_comments-before-except-val.ml.ref @@ -266,11 +266,9 @@ module A = struct end end -(* Same with get_pure, except that when we have both "x = t" and "y = t" - where t is a primed ident, * we add "x = y" to the result. This is crucial - for the normalizer, as it tend to drop "x = t" before * processing "y = - t". If we don't explicitly preserve "x = y", the normalizer cannot pick it - up *) +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, + * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before + * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) let _ = () (** Tags without text *) diff --git a/test/passing/tests/doc_comments-before.ml.err b/test/passing/tests/doc_comments-before.ml.err index dd738d90f3..71ec524f66 100644 --- a/test/passing/tests/doc_comments-before.ml.err +++ b/test/passing/tests/doc_comments-before.ml.err @@ -1 +1,4 @@ -Warning: tests/doc_comments.ml:301 exceeds the margin +Warning: tests/doc_comments.ml:268 exceeds the margin +Warning: tests/doc_comments.ml:269 exceeds the margin +Warning: tests/doc_comments.ml:270 exceeds the margin +Warning: tests/doc_comments.ml:299 exceeds the margin diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref index efa518581f..ae6ef68376 100644 --- a/test/passing/tests/doc_comments-before.ml.ref +++ b/test/passing/tests/doc_comments-before.ml.ref @@ -266,11 +266,9 @@ module A = struct end end -(* Same with get_pure, except that when we have both "x = t" and "y = t" - where t is a primed ident, * we add "x = y" to the result. This is crucial - for the normalizer, as it tend to drop "x = t" before * processing "y = - t". If we don't explicitly preserve "x = y", the normalizer cannot pick it - up *) +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, + * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before + * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) let _ = () (** Tags without text *) diff --git a/test/passing/tests/doc_comments.ml.err b/test/passing/tests/doc_comments.ml.err index dd738d90f3..71ec524f66 100644 --- a/test/passing/tests/doc_comments.ml.err +++ b/test/passing/tests/doc_comments.ml.err @@ -1 +1,4 @@ -Warning: tests/doc_comments.ml:301 exceeds the margin +Warning: tests/doc_comments.ml:268 exceeds the margin +Warning: tests/doc_comments.ml:269 exceeds the margin +Warning: tests/doc_comments.ml:270 exceeds the margin +Warning: tests/doc_comments.ml:299 exceeds the margin diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref index 59a6180c19..66cc7751a1 100644 --- a/test/passing/tests/doc_comments.ml.ref +++ b/test/passing/tests/doc_comments.ml.ref @@ -266,11 +266,9 @@ module A = struct end end -(* Same with get_pure, except that when we have both "x = t" and "y = t" - where t is a primed ident, * we add "x = y" to the result. This is crucial - for the normalizer, as it tend to drop "x = t" before * processing "y = - t". If we don't explicitly preserve "x = y", the normalizer cannot pick it - up *) +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, + * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before + * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) let _ = () (** Tags without text *) diff --git a/test/passing/tests/exp_grouping-parens.ml.err b/test/passing/tests/exp_grouping-parens.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/exp_grouping.ml.err b/test/passing/tests/exp_grouping.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/extensions-indent.ml.err b/test/passing/tests/extensions-indent.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/extensions-indent.mli.err b/test/passing/tests/extensions-indent.mli.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/function_indent-never.ml.err b/test/passing/tests/function_indent-never.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/function_indent.ml.err b/test/passing/tests/function_indent.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/indicate_multiline_delimiters-cosl.ml.err b/test/passing/tests/indicate_multiline_delimiters-cosl.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/invalid_docstrings.mli.err b/test/passing/tests/invalid_docstrings.mli.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/ite-fit_or_vertical.ml.err b/test/passing/tests/ite-fit_or_vertical.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/ite-fit_or_vertical_closing.ml.err b/test/passing/tests/ite-fit_or_vertical_closing.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.err b/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/ite-kr.ml.err b/test/passing/tests/ite-kr.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/ite-kr_closing.ml.err b/test/passing/tests/ite-kr_closing.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/ite-kw_first_closing.ml.err b/test/passing/tests/ite-kw_first_closing.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/ite-vertical.ml.err b/test/passing/tests/ite-vertical.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml index f8bd77d934..4b4e6504dc 100644 --- a/test/passing/tests/js_source.ml +++ b/test/passing/tests/js_source.ml @@ -8157,6 +8157,11 @@ let _ = (* *) +(*$ + (* + *) + *) + (** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx xxxx] xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *) @@ -8174,3 +8179,12 @@ module type M = sig : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.fooooooooooooooooooooooooo end + +(*$ + let _ = + [ x (* + *) + ; y + ] + ;; +*) diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 1c092ebdc0..889cce31c5 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -10228,8 +10228,7 @@ val fooooooooooooooooooooooooooooooo , fooooooooooooooooooooooooooooooo ) fooooooooooooooooooooooooooooooo -(* -*) +(* *) (** xxx @@ -10324,7 +10323,8 @@ let _ = (*$*) (*$ - [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + [%string + {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx zzzzzzzzzzzzzzzzzzzzzzzzzzzz |}] *) @@ -10422,6 +10422,8 @@ let _ = (* *) +(*$ (* *) *) + (** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx xxxx] xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *) @@ -10438,3 +10440,5 @@ module type M = sig : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.fooooooooooooooooooooooooo end + +(*$ let _ = [ x (* *); y ] *) diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index bc74fe3a0f..a60e340e05 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -1450,7 +1450,7 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = ;; (* - type (_,_) ty_assoc = +type (_,_) ty_assoc = | Anil : (unit,'e) ty_assoc | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc @@ -3314,7 +3314,7 @@ Error: Types marked with the immediate attribute must be New: implicit pack is also supported, and you only need to be able to infer the the module type path from the context. -*) + *) (* ocaml -principal *) (* Use a module pattern *) @@ -5236,7 +5236,7 @@ module type S' = S with module M := String (* with module type *) (* - module type S = sig module type T module F(X:T) : T end;; +module type S = sig module type T module F(X:T) : T end;; module type T0 = sig type t end;; module type S1 = S with module type T = T0;; module type S2 = S with module type T := T0;; @@ -6075,7 +6075,7 @@ class ['entity] entity_container = let f (x : entity entity_container) = () (* - class world = +class world = object val entity_container : entity entity_container = new entity_container @@ -10228,8 +10228,7 @@ val fooooooooooooooooooooooooooooooo , fooooooooooooooooooooooooooooooo ) fooooooooooooooooooooooooooooooo -(* - *) +(* *) (** xxx @@ -10324,7 +10323,8 @@ let _ = (*$*) (*$ - [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + [%string + {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx zzzzzzzzzzzzzzzzzzzzzzzzzzzz |}] *) @@ -10422,6 +10422,8 @@ let _ = (* *) +(*$ (* *) *) + (** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx xxxx] xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *) @@ -10438,3 +10440,5 @@ module type M = sig : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.fooooooooooooooooooooooooo end + +(*$ let _ = [ x (* *); y ] *) diff --git a/test/passing/tests/let_binding-in_indent.ml.err b/test/passing/tests/let_binding-in_indent.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/let_binding-indent.ml.err b/test/passing/tests/let_binding-indent.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/let_binding_spacing-sparse.ml.err b/test/passing/tests/let_binding_spacing-sparse.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/match_indent-never.ml.err b/test/passing/tests/match_indent-never.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/match_indent.ml.err b/test/passing/tests/match_indent.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/module_item_spacing-preserve.ml.err b/test/passing/tests/module_item_spacing-preserve.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/module_item_spacing.mli.err b/test/passing/tests/module_item_spacing.mli.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/open-closing-on-separate-line.ml.err b/test/passing/tests/open-closing-on-separate-line.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/parens_tuple_patterns.ml.err b/test/passing/tests/parens_tuple_patterns.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/sequence-preserve.ml.err b/test/passing/tests/sequence-preserve.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/sequence-preserve.ml.ref b/test/passing/tests/sequence-preserve.ml.ref index f166b4ea22..323209b026 100644 --- a/test/passing/tests/sequence-preserve.ml.ref +++ b/test/passing/tests/sequence-preserve.ml.ref @@ -91,10 +91,11 @@ let foo x y = another_important_function x y ; cleanup x y -(* This test require --max-iter=3 *) let _ = some statement ; - (* comment with an empty line in it tricky *) + (* comment with an empty line in it + + tricky *) an other statement let foo x y = diff --git a/test/passing/tests/sequence.ml b/test/passing/tests/sequence.ml index 260fdd39d6..92ebaddc0e 100644 --- a/test/passing/tests/sequence.ml +++ b/test/passing/tests/sequence.ml @@ -93,7 +93,6 @@ let foo x y = another_important_function x y ; cleanup x y -(* This test require --max-iter=3 *) let _ = some statement; (* comment with an empty line in it diff --git a/test/passing/tests/sequence.ml.err b/test/passing/tests/sequence.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/sequence.ml.opts b/test/passing/tests/sequence.ml.opts index e2b6533785..0eb0c717da 100644 --- a/test/passing/tests/sequence.ml.opts +++ b/test/passing/tests/sequence.ml.opts @@ -1 +1 @@ ---sequence-blank-line=compact --max-iter=3 +--sequence-blank-line=compact diff --git a/test/passing/tests/sequence.ml.ref b/test/passing/tests/sequence.ml.ref index 87c2afe57f..8d74ca96cb 100644 --- a/test/passing/tests/sequence.ml.ref +++ b/test/passing/tests/sequence.ml.ref @@ -79,10 +79,11 @@ let foo x y = another_important_function x y ; cleanup x y -(* This test require --max-iter=3 *) let _ = some statement ; - (* comment with an empty line in it tricky *) + (* comment with an empty line in it + + tricky *) an other statement let foo x y = diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err index 16b867f5da..50f7e55a5d 100644 --- a/test/passing/tests/source.ml.err +++ b/test/passing/tests/source.ml.err @@ -1,2 +1,2 @@ Warning: tests/source.ml:702 exceeds the margin -Warning: tests/source.ml:2311 exceeds the margin +Warning: tests/source.ml:2318 exceeds the margin diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 0ec00cfffc..8ffdea57f5 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -1469,15 +1469,22 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = function Thd, Noarg -> `Nil | Ttl Thd, v -> `Cons v end ) ) -(* type (_,_) ty_assoc = | Anil : (unit,'e) ty_assoc | Acons : string * - ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc - - and (_,_) ty_pvar = | Pnil : ('a,'e) ty_pvar | Pconst : 't * ('b,'e) - ty_pvar -> ('t -> 'b, 'e) ty_pvar | Parg : 't * ('a,'e) ty * ('b,'e) - ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar *) -(* An attempt at encoding omega examples from the 2nd Central European - Functional Programming School: Generic Programming in Omega, by Tim Sheard - and Nathan Linger http://web.cecs.pdx.edu/~sheard/ *) +(* +type (_,_) ty_assoc = + | Anil : (unit,'e) ty_assoc + | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc + +and (_,_) ty_pvar = + | Pnil : ('a,'e) ty_pvar + | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar + | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar +*) +(* + An attempt at encoding omega examples from the 2nd Central European + Functional Programming School: + Generic Programming in Omega, by Tim Sheard and Nathan Linger + http://web.cecs.pdx.edu/~sheard/ +*) (* Basic types *) @@ -1499,8 +1506,8 @@ let l1 = Scons (3, Scons (5, Snil)) (* We do not have type level functions, so we need to use witnesses. *) (* We copy here the definitions from section 3.9 *) -(* Note the addition of the ['a nat] argument to PlusZ, since we do not have - kinds *) +(* Note the addition of the ['a nat] argument to PlusZ, since we do not + have kinds *) type (_, _, _) plus = | PlusZ : 'a nat -> (zero, 'a, 'a) plus | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus @@ -3149,14 +3156,16 @@ Error: Types marked with the immediate attribute must be non-pointer types like int or bool |}] -(* Implicit unpack allows to omit the signature in (val ...) expressions. +(* + Implicit unpack allows to omit the signature in (val ...) expressions. - It also adds (module M : S) and (module M) patterns, relying on implicit - (val ...) for the implementation. Such patterns can only be used in - function definition, match clauses, and let ... in. + It also adds (module M : S) and (module M) patterns, relying on + implicit (val ...) for the implementation. Such patterns can only + be used in function definition, match clauses, and let ... in. - New: implicit pack is also supported, and you only need to be able to - infer the the module type path from the context. *) + New: implicit pack is also supported, and you only need to be able + to infer the the module type path from the context. + *) (* ocaml -principal *) (* Use a module pattern *) @@ -4985,15 +4994,23 @@ end module type S' = S with module M := String (* with module type *) -(* module type S = sig module type T module F(X:T) : T end;; module type T0 = - sig type t end;; module type S1 = S with module type T = T0;; module type - S2 = S with module type T := T0;; module type S3 = S with module type T := - sig type t = int end;; module H = struct include (Hashtbl : module type of - Hashtbl with type statistics := Hashtbl.statistics and module type S := - Hashtbl.S and module Make := Hashtbl.Make and module MakeSeeded := - Hashtbl.MakeSeeded and module type SeededS := Hashtbl.SeededS and module - type HashedType := Hashtbl.HashedType and module type SeededHashedType := - Hashtbl.SeededHashedType) end;; *) +(* +module type S = sig module type T module F(X:T) : T end;; +module type T0 = sig type t end;; +module type S1 = S with module type T = T0;; +module type S2 = S with module type T := T0;; +module type S3 = S with module type T := sig type t = int end;; +module H = struct + include (Hashtbl : module type of Hashtbl with + type statistics := Hashtbl.statistics + and module type S := Hashtbl.S + and module Make := Hashtbl.Make + and module MakeSeeded := Hashtbl.MakeSeeded + and module type SeededS := Hashtbl.SeededS + and module type HashedType := Hashtbl.HashedType + and module type SeededHashedType := Hashtbl.SeededHashedType) +end;; +*) (* A subtle problem appearing with -principal *) type -'a t @@ -5826,12 +5843,16 @@ class ['entity] entity_container = let f (x : entity entity_container) = () -(* class world = object val entity_container : entity entity_container = new - entity_container +(* +class world = + object + val entity_container : entity entity_container = new entity_container - method add_entity (s : entity) = entity_container#add_entity (s :> entity) + method add_entity (s : entity) = + entity_container#add_entity (s :> entity) - end *) + end +*) (* Two v's in the same class *) class c v = object diff --git a/test/passing/tests/str_value.ml.err b/test/passing/tests/str_value.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/try_with_or_pattern.ml.err b/test/passing/tests/try_with_or_pattern.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/types-indent.ml.err b/test/passing/tests/types-indent.ml.err deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/wrap_comments.ml b/test/passing/tests/wrap_comments.ml index 9f24983b48..f2002adf0d 100644 --- a/test/passing/tests/wrap_comments.ml +++ b/test/passing/tests/wrap_comments.ml @@ -54,6 +54,28 @@ let _ = () ;; +(* + * foo + * bar + *) + +(* + * foo + bar + *) + +let _ = + f + (* foo + *) + a + +(* 1 + * + 2 + * --- + * 3 + *) + [@@@ocamlformat "wrap-comments=false"] type t = @@ -179,3 +201,59 @@ let _ = *) () ;; + +(* + * foo + * bar + *) + +(* + * foo + bar + *) + +let _ = + (* It is very confusing - same expression has two different types in two contexts:*) + (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *) + (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*) + (* of RETURN_TYPE *) + (* Implications: *) + (* Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then *) + (* it means that it's not lvalue in clang's AST (it'd be reference otherwise) *) + (* Methods: method_deref_trans actually wants a pointer to the object, which is*) + (* equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE,*) + (* we optionally add pointer there to avoid backend confusion. *) + (* It works either way *) + (* Passing by value: may cause problems - there needs to be extra Sil.Load, but*) + (* doing so would create problems with methods. Passing structs by*) + (* value doesn't work good anyway. This may need to be revisited later*) + let x = y in z + +let _ = + (* It is very confusing - same expression has two different types in two contexts: + * 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue + * 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue + * of RETURN_TYPE + * Implications: + * Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then + * it means that it's not lvalue in clang's AST (it'd be reference otherwise) + * Methods: method_deref_trans actually wants a pointer to the object, which is + * equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE, + * we optionally add pointer there to avoid backend confusion. + * It works either way + * Passing by value: may cause problems - there needs to be extra Sil.Load, but + * doing so would create problems with methods. Passing structs by + * value doesn't work good anyway. This may need to be revisited later*) + let x = y in z + +let _ = + f + (* foo + *) + a + +(* 1 + * + 2 + * --- + * 3 + *) diff --git a/test/passing/tests/wrap_comments.ml.err b/test/passing/tests/wrap_comments.ml.err index 6f7c17597e..ed65e4c631 100644 --- a/test/passing/tests/wrap_comments.ml.err +++ b/test/passing/tests/wrap_comments.ml.err @@ -1 +1,19 @@ -Warning: tests/wrap_comments.ml:36 exceeds the margin +Warning: tests/wrap_comments.ml:59 exceeds the margin +Warning: tests/wrap_comments.ml:184 exceeds the margin +Warning: tests/wrap_comments.ml:185 exceeds the margin +Warning: tests/wrap_comments.ml:186 exceeds the margin +Warning: tests/wrap_comments.ml:190 exceeds the margin +Warning: tests/wrap_comments.ml:191 exceeds the margin +Warning: tests/wrap_comments.ml:192 exceeds the margin +Warning: tests/wrap_comments.ml:195 exceeds the margin +Warning: tests/wrap_comments.ml:196 exceeds the margin +Warning: tests/wrap_comments.ml:197 exceeds the margin +Warning: tests/wrap_comments.ml:202 exceeds the margin +Warning: tests/wrap_comments.ml:203 exceeds the margin +Warning: tests/wrap_comments.ml:204 exceeds the margin +Warning: tests/wrap_comments.ml:208 exceeds the margin +Warning: tests/wrap_comments.ml:209 exceeds the margin +Warning: tests/wrap_comments.ml:210 exceeds the margin +Warning: tests/wrap_comments.ml:213 exceeds the margin +Warning: tests/wrap_comments.ml:214 exceeds the margin +Warning: tests/wrap_comments.ml:215 exceeds the margin diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/tests/wrap_comments.ml.ref index a69a82c759..2f2be32386 100644 --- a/test/passing/tests/wrap_comments.ml.ref +++ b/test/passing/tests/wrap_comments.ml.ref @@ -9,10 +9,18 @@ type t = let _ = [ "a" ; "b" (* first line second line *) - ; "c" (* first line second line *) - ; "d" (* first line second line *) - ; "e" (* first line second line *) - ; "f" (* first line second line *) + ; "c" (* first line + + second line *) + ; "d" (* first line + + second line *) + ; "e" (* first line + + second line *) + ; "f" (* first line + + second line *) ; "g" ] let _ = @@ -30,6 +38,21 @@ let _ = (* blah blah *) () +(* + * foo + * bar + *) + +(* * foo bar *) + +let _ = f (* foo *) a + +(* 1 + * + 2 + * --- + * 3 + *) + [@@@ocamlformat "wrap-comments=false"] type t = @@ -85,35 +108,32 @@ type foo = let _ = [ "a" - ; "b" - (* first line - second line *) - ; "c" - (* first line + ; "b" (* first line + second line *) + ; "c" (* first line + + second line + *) + ; "d" (* first line + - second line - *) - ; "d" - (* first line + second line *) + ; "e" (* first line + second line + *) + ; "f" (* first line - second line *) - ; "e" - (* first line + second line - second line - *) - ; "f" - (* first line - second line - *) + *) ; "g" ] let _ = let _ = (* This is indented 7 - This 0 *) +This 0 *) 0 in 0 @@ -126,7 +146,7 @@ let _ = let _ = (*no space before just newline after - *) +*) 0 let _ = @@ -146,7 +166,62 @@ let _ = () let _ = - (* - blah blah + (* + blah blah *) () + +(* + * foo + * bar + *) + +(* + * foo + bar + *) + +let _ = + (* It is very confusing - same expression has two different types in two contexts:*) + (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *) + (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*) + (* of RETURN_TYPE *) + (* Implications: *) + (* Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then *) + (* it means that it's not lvalue in clang's AST (it'd be reference otherwise) *) + (* Methods: method_deref_trans actually wants a pointer to the object, which is*) + (* equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE,*) + (* we optionally add pointer there to avoid backend confusion. *) + (* It works either way *) + (* Passing by value: may cause problems - there needs to be extra Sil.Load, but*) + (* doing so would create problems with methods. Passing structs by*) + (* value doesn't work good anyway. This may need to be revisited later*) + let x = y in + z + +let _ = + (* It is very confusing - same expression has two different types in two contexts: + * 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue + * 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue + * of RETURN_TYPE + * Implications: + * Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then + * it means that it's not lvalue in clang's AST (it'd be reference otherwise) + * Methods: method_deref_trans actually wants a pointer to the object, which is + * equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE, + * we optionally add pointer there to avoid backend confusion. + * It works either way + * Passing by value: may cause problems - there needs to be extra Sil.Load, but + * doing so would create problems with methods. Passing structs by + * value doesn't work good anyway. This may need to be revisited later*) + let x = y in + z + +let _ = f (* foo + *) a + +(* 1 + * + 2 + * --- + * 3 + *)