diff --git a/CHANGES.md b/CHANGES.md index 9e078cf01f..a2cc1ff512 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,7 @@ profile. This started with version 0.26.0. - Fix extension-point spacing in structures (#2450, @Julow) - \* Consistent break after string constant argument (#2453, @Julow) - Fix invalid syntax generated with `ocp-indent-compat` (#2445, @Julow) +- Fixed bug with attributes on sub-expressions of infix operators (#2459, @tdelvecchio-jsc) ## 0.26.1 (2023-09-15) diff --git a/lib/Sugar.ml b/lib/Sugar.ml index 7e39c8d8b9..fb3c8f2b3f 100644 --- a/lib/Sugar.ml +++ b/lib/Sugar.ml @@ -76,9 +76,13 @@ let cl_fun ?(will_keep_first_ast_node = true) cmts xexp = module Exp = struct let infix cmts prec xexp = let assoc = Option.value_map prec ~default:Assoc.Non ~f:Assoc.of_prec in - let rec infix_ ?(relocate = true) xop xexp = + let rec infix_ ?(child_expr = true) xop xexp = let ctx = Exp xexp.ast in match (assoc, xexp.ast) with + | _, {pexp_attributes= _ :: _; _} when child_expr -> + (* Avoid dropping attributes on child expressions, e.g. [(a + b) + [@attr] + c] *) + [(xop, xexp)] | ( Left , {pexp_desc= Pexp_infix ({txt= op; loc}, e1, e2); pexp_loc= src; _} ) @@ -90,7 +94,8 @@ module Exp = struct | (None, {ast= {pexp_loc; _}; _}) :: _ -> pexp_loc | _ -> loc in - if relocate then Cmts.relocate cmts ~src ~before ~after:e2.pexp_loc ; + if child_expr then + Cmts.relocate cmts ~src ~before ~after:e2.pexp_loc ; op_args1 @ [(Some {txt= op; loc}, sub_exp ~ctx e2)] | ( Right , {pexp_desc= Pexp_infix ({txt= op; loc}, e1, e2); pexp_loc= src; _} @@ -105,11 +110,11 @@ module Exp = struct | Some (_, {ast= {pexp_loc; _}; _}) -> pexp_loc | None -> e1.pexp_loc in - if relocate then Cmts.relocate cmts ~src ~before ~after ; + if child_expr then Cmts.relocate cmts ~src ~before ~after ; (xop, sub_exp ~ctx e1) :: op_args2 | _ -> [(xop, xexp)] in - infix_ None ~relocate:false xexp + infix_ None ~child_expr:false xexp end let sequence cmts xexp = diff --git a/test/passing/tests/comments.ml b/test/passing/tests/comments.ml index ed4f0965cc..f6fa2146e7 100644 --- a/test/passing/tests/comments.ml +++ b/test/passing/tests/comments.ml @@ -311,3 +311,7 @@ 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] diff --git a/test/passing/tests/comments.ml.ref b/test/passing/tests/comments.ml.ref index bfd372971a..548fdc173f 100644 --- a/test/passing/tests/comments.ml.ref +++ b/test/passing/tests/comments.ml.ref @@ -420,3 +420,7 @@ type t = stuff *) x: int } + +let _ = (x + y) [@attr] + z + +let _ = x ^ (y ^ z) [@attr]