Merge pull request #10593 from voodoos/fix-untypeast-for-patterns

Fix untypeast for patterns

(cherry picked from commit dbce6c200febdd2404eb2cc0f7316a4a401427b1)

3 files changed, 30 insertions, 6 deletions

diff --git a/Changes b/Changes
index f74ec053a5..588749256f 100644
--- a/Changes
+++ b/Changes
@@ -603,6 +603,10 @@ OCaml 4.13.0
   optional libraries have been disabled.
   (David Allsopp, report by Yuri Victorovich review by Florian Angeletti)
 
+- #10593: Fix untyping of patterns without named existential quantifiers. This
+  bug was only present in the beta version of OCaml 4.13.0.
+  (Ulysse Gérard, review by Florian Angeletti)
+
 OCaml 4.12, maintenance version
 -------------------------------
 
diff --git a/testsuite/tests/compiler-libs/test_untypeast.ml b/testsuite/tests/compiler-libs/test_untypeast.ml
new file mode 100644
index 0000000000..c342a0f5b6
--- /dev/null
+++ b/testsuite/tests/compiler-libs/test_untypeast.ml
@@ -0,0 +1,17 @@
+(* TEST
+   flags = "-I ${ocamlsrcdir}/typing \
+    -I ${ocamlsrcdir}/parsing"
+   include ocamlcommon
+   * expect
+*)
+
+let res =
+  let s = {| match None with Some (Some _) -> () | _ -> () |} in
+  let pe = Parse.expression (Lexing.from_string s) in
+  let te = Typecore.type_expression (Env.initial_safe_string) pe in
+  let ute = Untypeast.untype_expression te in
+  Format.asprintf "%a" Pprintast.expression ute
+
+[%%expect{|
+val res : string = "match None with | Some (Some _) -> () | _ -> ()"
+|}]
diff --git a/typing/untypeast.ml b/typing/untypeast.ml
index ad9d74fba6..6e54cb249c 100644
--- a/typing/untypeast.ml
+++ b/typing/untypeast.ml
@@ -330,12 +330,14 @@ let pattern : type k . _ -> k T.general_pattern -> _ = fun sub pat ->
     | Tpat_tuple list ->
         Ppat_tuple (List.map (sub.pat sub) list)
     | Tpat_construct (lid, _, args, vto) ->
-        let vl, tyo =
+        let tyo =
           match vto with
-            None -> [], None
+            None -> None
           | Some (vl, ty) ->
-              List.map (fun x -> {x with txt = Ident.name x.txt}) vl,
-              Some (sub.typ sub ty)
+              let vl =
+                List.map (fun x -> {x with txt = Ident.name x.txt}) vl
+              in
+              Some (vl, sub.typ sub ty)
         in
         let arg =
           match args with
@@ -345,9 +347,10 @@ let pattern : type k . _ -> k T.general_pattern -> _ = fun sub pat ->
         in
         Ppat_construct (map_loc sub lid,
           match tyo, arg with
-          | Some ty, Some arg ->
+          | Some (vl, ty), Some arg ->
               Some (vl, Pat.mk ~loc (Ppat_constraint (arg, ty)))
-          | _ -> None)
+          | None, Some arg -> Some ([], arg)
+          | _, None -> None)
     | Tpat_variant (label, pato, _) ->
         Ppat_variant (label, Option.map (sub.pat sub) pato)
     | Tpat_record (list, closed) ->