Fix unstable comments around attributes (ocaml-ppx#1029)

CHANGES.md

@@ -1,5 +1,6 @@
 ### (master)
 
+  + Fix unstable comments around attributes (#1029) (Guillaume Petiot)
   + Improve: use the same sets of options for both branches by default in test_branch.sh (#1033) (Guillaume Petiot)
   + Fix test_branch.sh and CI checking of CHANGES.md (#1032, #1034) (Jules Aguillon)
   + Fix flag of git-worktree in test_branch.sh and bisect.sh (#1027) (Guillaume Petiot)

src/Fmt_ast.ml

@@ -616,7 +616,8 @@ and fmt_attributes c ?(pre = noop) ?(suf = noop) ~key attrs =
   let num = List.length attrs in
   let fmt_attr ~first ~last {attr_name; attr_payload; attr_loc} =
     fmt_or_k first (open_hvbox 0) (fmt "@ ")
-    $ Cmts.fmt c attr_loc (fmt_attribute c key (attr_name, attr_payload))
+    $ hvbox 0
+        (Cmts.fmt c attr_loc (fmt_attribute c key (attr_name, attr_payload)))
     $ fmt_if_k last (close_box $ suf)
   in
   fmt_if_k (num > 0) (pre $ hvbox_if (num > 1) 0 (list_fl attrs fmt_attr))
@@ -2988,8 +2989,7 @@ and fmt_class_params c ctx params =
     (hvbox 0
        (wrap_fits_breaks c.conf "[" "]" (list_fl params fmt_param) $ fmt "@ "))
 
-and fmt_type_declaration c ?ext ?(pre = "") ?(brk = noop) ctx ?fmt_name
-    ?(eq = "=") decl =
+and fmt_type_declaration c ?ext ?(pre = "") ctx ?fmt_name ?(eq = "=") decl =
   let { ptype_name= {txt; loc}
       ; ptype_params
       ; ptype_cstrs
@@ -3002,7 +3002,7 @@ and fmt_type_declaration c ?ext ?(pre = "") ?(brk = noop) ctx ?fmt_name
   in
   update_config_maybe_disabled c ptype_loc ptype_attributes
   @@ fun c ->
-  let fmt_manifest ~priv manifest decl =
+  let fmt_manifest ~priv decl =
     let break_before_manifest_kind =
       match ptype_kind with
       | Ptype_abstract -> fmt "@ "
@@ -3013,7 +3013,7 @@ and fmt_type_declaration c ?ext ?(pre = "") ?(brk = noop) ctx ?fmt_name
       $ fmt_core_type c ~in_type_declaration:true (sub_typ ~ctx typ)
     in
     let eq = str " " $ str eq in
-    match (manifest, decl) with
+    match (ptype_manifest, decl) with
     | Some m, Some d -> eq $ fmt_manifest m $ str " =" $ d
     | Some m, None -> eq $ fmt_manifest m
     | None, Some d -> eq $ d
@@ -3031,12 +3031,13 @@ and fmt_type_declaration c ?ext ?(pre = "") ?(brk = noop) ctx ?fmt_name
           $ Option.value fmt_name ~default:(str txt) )
       $ k )
   in
-  let fmt_manifest_kind mfst priv kind =
-    match kind with
-    | Ptype_abstract -> box_manifest (fmt_manifest ~priv mfst None)
+  let fmt_manifest_kind =
+    let priv = ptype_private in
+    match ptype_kind with
+    | Ptype_abstract -> box_manifest (fmt_manifest ~priv None)
     | Ptype_variant [] ->
         box_manifest
-          (fmt_manifest ~priv:Public mfst (Some (fmt_private_flag priv)))
+          (fmt_manifest ~priv:Public (Some (fmt_private_flag priv)))
         $ fmt "@ |"
     | Ptype_variant ctor_decls ->
         let max acc d =
@@ -3045,7 +3046,7 @@ and fmt_type_declaration c ?ext ?(pre = "") ?(brk = noop) ctx ?fmt_name
         in
         let max_len_name = List.fold_left ctor_decls ~init:0 ~f:max in
         box_manifest
-          (fmt_manifest ~priv:Public mfst (Some (fmt_private_flag priv)))
+          (fmt_manifest ~priv:Public (Some (fmt_private_flag priv)))
         $ fmt "@ "
         $ list_fl ctor_decls
             (fmt_constructor_declaration c ~max_len_name ctx)
@@ -3058,14 +3059,14 @@ and fmt_type_declaration c ?ext ?(pre = "") ?(brk = noop) ctx ?fmt_name
           $ fmt_if_k (not last) p.sep_after
         in
         box_manifest
-          (fmt_manifest ~priv:Public mfst
+          (fmt_manifest ~priv:Public
              (Some (fmt_private_flag priv $ p.docked_before)))
         $ p.break_before
         $ p.box_record (list_fl lbl_decls fmt_decl)
         $ p.break_after $ p.docked_after
     | Ptype_open ->
         box_manifest
-          (fmt_manifest ~priv:Public mfst
+          (fmt_manifest ~priv:Public
              (Some (fmt_private_flag priv $ str " ..")))
   in
   let fmt_cstr (t1, t2, loc) =
@@ -3094,11 +3095,9 @@ and fmt_type_declaration c ?ext ?(pre = "") ?(brk = noop) ctx ?fmt_name
        ( doc_before
        $ hvbox 0
            ( hvbox c.conf.type_decl_indent
-               ( fmt_manifest_kind ptype_manifest ptype_private ptype_kind
-               $ fmt_cstrs ptype_cstrs )
+               (fmt_manifest_kind $ fmt_cstrs ptype_cstrs)
            $ fmt_attributes c ~pre:(fmt "@ ") ~key:"@@" atrs )
        $ doc_after )
-  $ brk
 
 and fmt_label_declaration c ctx decl ?(last = false) =
   let {pld_mutable; pld_name; pld_type; pld_loc; pld_attributes} = decl in
@@ -3983,10 +3982,9 @@ and fmt_type c ?ext ?eq rec_flag decls ctx =
       if first then
         if Poly.(rec_flag = Recursive) then "type" else "type nonrec"
       else "and"
-    and brk = fmt_if (not last) "\n" in
+    in
     let ext = if first then ext else None in
-    fmt_type_declaration c ~pre ?eq ?ext ~brk ctx decl
-    $ fmt_if (not last) "@ "
+    fmt_type_declaration c ~pre ?eq ?ext ctx decl $ fmt_if (not last) "\n@ "
   in
   vbox 0 (list_fl decls fmt_decl)
 

test/passing/attributes.ml

@@ -178,3 +178,10 @@ type t = {a: int}
 module type A = sig
   module A := A.B [@@attr]
 end
+
+module M = struct
+  type t
+  [@@immediate]
+  (* ______________________________________ *)
+  [@@deriving variants, sexp_of]
+end

test/passing/js_source.ml

@@ -7417,3 +7417,10 @@ exception First_exception
 
 (** Second documentation comment. *)
 exception Second_exception
+
+module M = struct
+  type t
+  [@@immediate]
+  (* ______________________________________ *)
+  [@@deriving variants, sexp_of]
+end

test/passing/js_source.ml.ref

@@ -9806,3 +9806,9 @@ exception First_exception
 
 (** Second documentation comment. *)
 exception Second_exception
+
+module M = struct
+  type t
+  [@@immediate] (* ______________________________________ *)
+  [@@deriving variants, sexp_of]
+end