summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2013-09-06 05:35:55 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2013-09-06 05:35:55 +0000
commitd09dee8f9cb262bab405f61a4b02ac4f8f2cb19c (patch)
tree63170953cad758ee648b20dedc318069a933f5d1
parent567bca77d28c082c9385f442c3d6f6be8771626c (diff)
Fix PR#6163
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14065 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--Changes1
-rw-r--r--testsuite/tests/typing-gadts/pr6163.ml14
-rw-r--r--testsuite/tests/typing-gadts/pr6163.ml.principal.reference0
-rw-r--r--testsuite/tests/typing-gadts/pr6163.ml.reference0
-rw-r--r--typing/ctype.ml6
5 files changed, 21 insertions, 0 deletions
diff --git a/Changes b/Changes
index 8f920dc17..e02afa75a 100644
--- a/Changes
+++ b/Changes
@@ -240,6 +240,7 @@ Bug fixes:
- PR#6109: Typos in ocamlbuild error messages
- PR#6123: Assert failure when self escapes its class
- PR#6158: Fatal error using GADTs
+- PR#6163: Assert_failure using polymorphic variants in GADTs
Feature wishes:
- PR#5181: Merge common floating point constants in ocamlopt
diff --git a/testsuite/tests/typing-gadts/pr6163.ml b/testsuite/tests/typing-gadts/pr6163.ml
new file mode 100644
index 000000000..e9646196e
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6163.ml
@@ -0,0 +1,14 @@
+type _ nat =
+ Zero : [`Zero] nat
+ | Succ : 'a nat -> [`Succ of 'a] nat;;
+type 'a pre_nat = [`Zero | `Succ of 'a];;
+type aux =
+ | Aux : [`Succ of [<[<[<[`Zero] pre_nat] pre_nat] pre_nat]] nat -> aux;;
+
+let f (Aux x) =
+ match x with
+ | Succ Zero -> "1"
+ | Succ (Succ Zero) -> "2"
+ | Succ (Succ (Succ Zero)) -> "3"
+ | Succ (Succ (Succ (Succ Zero))) -> "4"
+;;
diff --git a/testsuite/tests/typing-gadts/pr6163.ml.principal.reference b/testsuite/tests/typing-gadts/pr6163.ml.principal.reference
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6163.ml.principal.reference
diff --git a/testsuite/tests/typing-gadts/pr6163.ml.reference b/testsuite/tests/typing-gadts/pr6163.ml.reference
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6163.ml.reference
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 1d91fb767..8bd28e1c1 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -982,6 +982,12 @@ let rec copy ?env ?partial ?keep_names ty =
if keep then more else newty more.desc
| _ -> assert false
in
+ let row =
+ match repr more' with (* PR#6163 *)
+ {desc=Tconstr _} when not row.row_fixed ->
+ {row with row_fixed = true}
+ | _ -> row
+ in
(* Open row if partial for pattern and contains Reither *)
let more', row =
match partial with