Improve the placement of begin..end attributes (#2551)

* Parenthese begin..end with attributes

This fixes a AST changed bug by adding parentheses.

* Improve the placement of begin..end attributes

Render 'begin [@attr] .. end' instead of 'begin .. end [@attr]'. This
removes parentheses.

* Update changes

CHANGES.md

@@ -51,6 +51,8 @@ profile. This started with version 0.26.0.
 - Fix comments around underscore in record patterns (#2540, @Julow)
 - Fix dropped comments before `begin .. end` in a match case (#2541, @Julow)
 - Fix closing `*)` in doc-comments exceeding the margin (#2550, @Julow)
+- Fix invalid syntax geneated for begin..end attributes (#2551, @Julow)
+  The attribute is moved from `begin .. end [@attr]` to `begin [@attr] .. end`.
 
 ### Changes
 - The location of attributes for structure items is now tracked and preserved. (#2247, @EmileTrotignon)

lib/Fmt_ast.ml

@@ -2851,9 +2851,10 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
   | Pexp_hole -> pro $ hvbox 0 (fmt_hole () $ fmt_atrs)
   | Pexp_beginend e ->
       let wrap_beginend k =
-        let opn = str "begin" $ fmt_extension_suffix c ext
+        let opn =
+          hvbox 0 (str "begin" $ fmt_extension_suffix c ext $ fmt_atrs)
         and cls = str "end" in
-        hvbox 0 (wrap opn cls (wrap (break 1 2) force_break k) $ fmt_atrs)
+        hvbox 0 (wrap opn cls (wrap (break 1 2) force_break k))
       in
       pro
       $ wrap_beginend

test/passing/tests/attributes.ml

@@ -439,3 +439,23 @@ let _ = f ((1 : int) [@a]) ((1 : int) [@a])
 let _ = f ((((1 : int) [@a]) : (int[@b])) [@a]) ((1 : int) [@a])
 
 include [@foo] M [@boo]
+
+let () =
+  let () =
+    S.ntyp Cbor_type.Reserved
+    @@ S.tok
+         begin [@warning "-4"]
+           fun ev ->
+             match ev with Cbor_event.Reserved int -> Some int | _ -> None
+         end
+  in
+  ()
+
+let () =
+  let () =
+    S.ntyp Cbor_type.Reserved
+    @@ (S.tok (fun ev ->
+            match ev with Cbor_event.Reserved int -> Some int | _ -> None )
+       [@warning "-4"] )
+  in
+  ()

test/passing/tests/exp_grouping-parens.ml.ref

@@ -301,10 +301,9 @@ let _ = [%ext x y]
 let _ = [%ext (* foo *) x y]
 
 let _ =
-  begin
+  begin [@landmark "parse_constant_dividends"]
     market_data_items := ()
   end
-  [@landmark "parse_constant_dividends"]
 
 let () = if a then b (* asd *)
 
@@ -316,25 +315,23 @@ let x =
       match Tbl.find dist_tbl (pv1, pv2) with
       | None ->
         (* FIXME: temporary hack to avoid Jane Street's annoying warnings. *)
-        begin
+        begin [@warning "-3"]
           try
             let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in
             let path = unwrap_path path' in
             Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist) ;
             Some (path, dist)
           with Not_found | Not_found_s _ -> None
         end
-        [@warning "-3"]
       | pd -> pd
   in
   ()
 
 let _ =
   if something_changed then
-    begin
+    begin [@attr]
       loop
     end
-    [@attr]
 
 let _ =
   match x with
@@ -345,7 +342,6 @@ let _ =
 let _ =
   match x with
   | _ ->
-    begin
+    begin [@foo]
       y
     end
-    [@foo]

test/passing/tests/exp_grouping.ml.ref

@@ -351,10 +351,9 @@ let _ =
   end
 
 let _ =
-  begin
+  begin [@landmark "parse_constant_dividends"]
     market_data_items := ()
   end
-  [@landmark "parse_constant_dividends"]
 
 let () =
   if a then begin
@@ -370,25 +369,23 @@ let x =
       match Tbl.find dist_tbl (pv1, pv2) with
       | None ->
         (* FIXME: temporary hack to avoid Jane Street's annoying warnings. *)
-        begin
+        begin [@warning "-3"]
           try
             let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in
             let path = unwrap_path path' in
             Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist) ;
             Some (path, dist)
           with Not_found | Not_found_s _ -> None
         end
-        [@warning "-3"]
       | pd -> pd
   in
   ()
 
 let _ =
   if something_changed then
-    begin
+    begin [@attr]
       loop
     end
-    [@attr]
 
 let _ =
   match x with
@@ -401,7 +398,6 @@ let _ =
 let _ =
   match x with
   | _ ->
-    begin
+    begin [@foo]
       y
     end
-    [@foo]

test/passing/tests/js_source.ml.err

@@ -1,6 +1,6 @@
-Warning: tests/js_source.ml:162 exceeds the margin
-Warning: tests/js_source.ml:9560 exceeds the margin
-Warning: tests/js_source.ml:9664 exceeds the margin
-Warning: tests/js_source.ml:9723 exceeds the margin
-Warning: tests/js_source.ml:9805 exceeds the margin
-Warning: tests/js_source.ml:10304 exceeds the margin
+Warning: tests/js_source.ml:161 exceeds the margin
+Warning: tests/js_source.ml:9559 exceeds the margin
+Warning: tests/js_source.ml:9663 exceeds the margin
+Warning: tests/js_source.ml:9722 exceeds the margin
+Warning: tests/js_source.ml:9804 exceeds the margin
+Warning: tests/js_source.ml:10303 exceeds the margin

test/passing/tests/js_source.ml.ocp

@@ -110,10 +110,9 @@ let () =
   [%foo lazy x [@foo]];
   [%foo object end [@foo]];
   [%foo
-    begin
+    begin [@foo]
       3
-    end
-    [@foo]];
+    end];
   [%foo new x [@foo]];
   [%foo
     match[@foo] () with

test/passing/tests/js_source.ml.ref

@@ -110,10 +110,9 @@ let () =
   [%foo lazy x [@foo]];
   [%foo object end [@foo]];
   [%foo
-    begin
+    begin [@foo]
       3
-    end
-    [@foo]];
+    end];
   [%foo new x [@foo]];
   [%foo
     match[@foo] () with

test/passing/tests/source.ml.err

@@ -1,2 +1,2 @@
-Warning: tests/source.ml:704 exceeds the margin
-Warning: tests/source.ml:2321 exceeds the margin
+Warning: tests/source.ml:703 exceeds the margin
+Warning: tests/source.ml:2320 exceeds the margin

test/passing/tests/source.ml.ref

@@ -120,10 +120,9 @@ let () =
   [%foo lazy x [@foo]] ;
   [%foo object end [@foo]] ;
   [%foo
-    begin
+    begin [@foo]
       3
-    end
-    [@foo]] ;
+    end] ;
   [%foo new x [@foo]] ;
   [%foo
     match[@foo] () with