Fix issue #2729 (#2735)

EmileTrotignon · web-flow · commit 5e74455079fe · 2025-10-24T12:09:00.000+02:00
* add test showcasing issue

* fix issue

* promote test
diff --git a/test/passing/refs.ahrefs/labeled_tuples.ml.err b/test/passing/refs.ahrefs/labeled_tuples.ml.err
@@ -0,0 +1,2 @@
+Warning: labeled_tuples.ml:634 exceeds the margin
+Warning: labeled_tuples.ml:635 exceeds the margin
diff --git a/test/passing/refs.ahrefs/labeled_tuples.ml.ref b/test/passing/refs.ahrefs/labeled_tuples.ml.ref
@@ -629,3 +629,11 @@ let
     (* after y *),
     (* bz *)
     ~z:(*zv*) 0 (*end*) )
+
+module type T = sig
+  val x :
+    from:ttttttttttttttttttttttttttttttttt * ttttttttttttttttttttttttttttttttttt ->
+    tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt ->
+    a ->
+    'b
+end
diff --git a/test/passing/refs.default/labeled_tuples.ml.err b/test/passing/refs.default/labeled_tuples.ml.err
@@ -1 +1,3 @@
 Warning: labeled_tuples.ml:200 exceeds the margin
+Warning: labeled_tuples.ml:573 exceeds the margin
+Warning: labeled_tuples.ml:574 exceeds the margin
diff --git a/test/passing/refs.default/labeled_tuples.ml.ref b/test/passing/refs.default/labeled_tuples.ml.ref
@@ -568,3 +568,11 @@ let
     (* after y *),
     (* bz *)
     ~z:(*zv*) 0 (*end*) )
+
+module type T = sig
+  val x :
+    from:ttttttttttttttttttttttttttttttttt * ttttttttttttttttttttttttttttttttttt ->
+    tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt ->
+    a ->
+    'b
+end
diff --git a/test/passing/refs.janestreet/labeled_tuples.ml.err b/test/passing/refs.janestreet/labeled_tuples.ml.err
@@ -0,0 +1 @@
+Warning: labeled_tuples.ml:634 exceeds the margin
diff --git a/test/passing/refs.janestreet/labeled_tuples.ml.ref b/test/passing/refs.janestreet/labeled_tuples.ml.ref
@@ -628,3 +628,11 @@ let
   , (* bz *)
     ~z:(*zv*) 0 (*end*) )
 ;;
+
+module type T = sig
+  val x
+    :  from:ttttttttttttttttttttttttttttttttt * ttttttttttttttttttttttttttttttttttt
+    -> tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt
+    -> a
+    -> 'b
+end
diff --git a/test/passing/refs.ocamlformat/labeled_tuples.ml.err b/test/passing/refs.ocamlformat/labeled_tuples.ml.err
@@ -1 +1,2 @@
 Warning: labeled_tuples.ml:223 exceeds the margin
+Warning: labeled_tuples.ml:641 exceeds the margin
diff --git a/test/passing/refs.ocamlformat/labeled_tuples.ml.ref b/test/passing/refs.ocamlformat/labeled_tuples.ml.ref
@@ -634,3 +634,12 @@ let
     (* after y *)
   , (* bz *)
     ~z:(*zv*) 0 (*end*) )
+
+module type T = sig
+  val x :
+       from:
+         ttttttttttttttttttttttttttttttttt * ttttttttttttttttttttttttttttttttttt
+    -> tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt
+    -> a
+    -> 'b
+end
diff --git a/test/passing/tests/labeled_tuples.ml b/test/passing/tests/labeled_tuples.ml
@@ -657,3 +657,11 @@ let (*before*) ~(x (*l-ty*):int (*after-ty*)) (*after x*),
     (*before y*) ~y (* after y *), (* bz *) ~z:(*zv*)0 (*end*) =
   (*before*) ~(x (*l-ty*):int (*after-ty*)) (*after x*),
     (*before y*) ~y (* after y *), (* bz *)~z:(*zv*)0 (*end*)
+
+module type T = sig
+  val x
+    :  from:ttttttttttttttttttttttttttttttttt * ttttttttttttttttttttttttttttttttttt
+    -> tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt
+    -> a
+    -> 'b
+end
diff --git a/vendor/parser-extended/parser.mly b/vendor/parser-extended/parser.mly
@@ -3627,7 +3627,12 @@ function_type:
             pap_type = domain;
           }
           in
-          Ptyp_arrow([arrow_type], codomain) }
+          let params, codomain =
+            match codomain.ptyp_attributes, codomain.ptyp_desc with
+            | [], Ptyp_arrow (params, codomain) -> params, codomain
+            | _, _ -> [], codomain
+          in
+          Ptyp_arrow(arrow_type :: params, codomain) }
     )
     { $1 }
   | label = LIDENT COLON proper_tuple_type %prec MINUSGREATER

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+Warning: labeled_tuples.ml:634 exceeds the margin`
	`2`	`+Warning: labeled_tuples.ml:635 exceeds the margin`
Original file line number	Diff line number	Diff line change
`@@ -1 +1,3 @@`
`1`	`1`	`Warning: labeled_tuples.ml:200 exceeds the margin`
	`2`	`+Warning: labeled_tuples.ml:573 exceeds the margin`
	`3`	`+Warning: labeled_tuples.ml:574 exceeds the margin`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1 @@`
	`1`	`+Warning: labeled_tuples.ml:634 exceeds the margin`
Original file line number	Diff line number	Diff line change
`@@ -1 +1,2 @@`
`1`	`1`	`Warning: labeled_tuples.ml:223 exceeds the margin`
	`2`	`+Warning: labeled_tuples.ml:641 exceeds the margin`
Original file line number	Diff line number	Diff line change
`@@ -3627,7 +3627,12 @@ function_type:`
`3627`	`3627`	`pap_type = domain;`
`3628`	`3628`	`}`
`3629`	`3629`	`in`
`3630`		`- Ptyp_arrow([arrow_type], codomain) }`
	`3630`	`+ let params, codomain =`
	`3631`	`+ match codomain.ptyp_attributes, codomain.ptyp_desc with`
	`3632`	`+ \| [], Ptyp_arrow (params, codomain) -> params, codomain`
	`3633`	`+ \| _, _ -> [], codomain`
	`3634`	`+ in`
	`3635`	`+ Ptyp_arrow(arrow_type :: params, codomain) }`
`3631`	`3636`	`)`
`3632`	`3637`	`{ $1 }`
`3633`	`3638`	`\| label = LIDENT COLON proper_tuple_type %prec MINUSGREATER`