diff options
author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2013-09-06 05:35:55 +0000 |
---|---|---|
committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2013-09-06 05:35:55 +0000 |
commit | d09dee8f9cb262bab405f61a4b02ac4f8f2cb19c (patch) | |
tree | 63170953cad758ee648b20dedc318069a933f5d1 | |
parent | 567bca77d28c082c9385f442c3d6f6be8771626c (diff) |
Fix PR#6163
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14065 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r-- | Changes | 1 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/pr6163.ml | 14 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/pr6163.ml.principal.reference | 0 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/pr6163.ml.reference | 0 | ||||
-rw-r--r-- | typing/ctype.ml | 6 |
5 files changed, 21 insertions, 0 deletions
@@ -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 |