Remove a call to enforce_constraints when checking GADT patterns

3 files changed, 33 insertions, 3 deletions

diff --git a/testsuite/tests/typing-gadts/gadthead.ml b/testsuite/tests/typing-gadts/gadthead.ml
new file mode 100644
index 0000000000..57a0f04d82
--- /dev/null
+++ b/testsuite/tests/typing-gadts/gadthead.ml
@@ -0,0 +1,30 @@
+(* TEST
+   * expect
+*)
+
+module M : sig
+  type t
+  val x : t
+  val print : t -> unit
+end = struct
+  type t = string
+  let x = "hello"
+  let print = print_endline
+end
+
+type _ g = I : int g
+[%%expect{|
+module M : sig type t val x : t val print : t -> unit end
+type _ g = I : int g
+|}]
+
+let g (x : M.t) =
+  match x with I -> M.print I
+let () = g M.x
+[%%expect{|
+Line 2, characters 15-16:
+2 |   match x with I -> M.print I
+                   ^
+Error: This pattern matches values of type 'a g
+       but a pattern was expected which matches values of type M.t
+|}]
diff --git a/testsuite/tests/typing-gadts/principality-and-gadts.ml b/testsuite/tests/typing-gadts/principality-and-gadts.ml
index 65db66e267..1798cda08b 100644
--- a/testsuite/tests/typing-gadts/principality-and-gadts.ml
+++ b/testsuite/tests/typing-gadts/principality-and-gadts.ml
@@ -362,7 +362,7 @@ val foo : int foo -> int = <fun>
 Line 3, characters 26-31:
 3 |   | { x = (x : int); eq = Refl3 } -> x
                               ^^^^^
-Warning 18 [not-principal]: typing this pattern requires considering M.t and N.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and int as equal.
 But the knowledge of these types is not principal.
 val foo : int foo -> int = <fun>
 |}]
@@ -404,7 +404,7 @@ val foo : string foo -> string = <fun>
 Line 3, characters 29-34:
 3 |   | { x = (x : string); eq = Refl3 } -> x
                                  ^^^^^
-Warning 18 [not-principal]: typing this pattern requires considering M.t and N.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and string as equal.
 But the knowledge of these types is not principal.
 val foo : string foo -> string = <fun>
 |}]
diff --git a/testsuite/tests/typing-gadts/test.ml b/testsuite/tests/typing-gadts/test.ml
index 6cef6df8a9..4259b31b97 100644
--- a/testsuite/tests/typing-gadts/test.ml
+++ b/testsuite/tests/typing-gadts/test.ml
@@ -404,7 +404,7 @@ end;;
 Line 5, characters 6-9:
 5 |       Foo -> 5
           ^^^
-Error: This pattern matches values of type int t
+Error: This pattern matches values of type 'a t
        but a pattern was expected which matches values of type int
 |}];;