diff options
| -rw-r--r-- | Changes | 1 | ||||
| -rw-r--r-- | testsuite/tests/typing-misc/wellfounded.ml | 11 | ||||
| -rw-r--r-- | testsuite/tests/typing-misc/wellfounded.ml.principal.reference | 7 | ||||
| -rw-r--r-- | testsuite/tests/typing-misc/wellfounded.ml.reference | 7 | ||||
| -rw-r--r-- | typing/typedecl.ml | 2 |
5 files changed, 27 insertions, 1 deletions
@@ -136,6 +136,7 @@ Bug fixes: - PR#6727: Printf.sprintf "%F" misbehavior (Benoît Vaugon, report by Vassili Karpov) - PR#6763: #show with -short-paths doesn't select shortest type paths +- PR#6768: Typechecker overflow the stack on cyclic type - ocamlbuild on cygwin cannot find ocamlfind (user 'algoriddle') - allow android build with pthreads support (since SDK r10c) diff --git a/testsuite/tests/typing-misc/wellfounded.ml b/testsuite/tests/typing-misc/wellfounded.ml new file mode 100644 index 000000000..b33adc5e1 --- /dev/null +++ b/testsuite/tests/typing-misc/wellfounded.ml @@ -0,0 +1,11 @@ +(* PR#6768 *) + +type _ prod = Prod : ('a * 'y) prod;; + +let f : type t. t prod -> _ = function Prod -> + let module M = + struct + type d = d * d + end + in () +;; diff --git a/testsuite/tests/typing-misc/wellfounded.ml.principal.reference b/testsuite/tests/typing-misc/wellfounded.ml.principal.reference new file mode 100644 index 000000000..0c9e64ad0 --- /dev/null +++ b/testsuite/tests/typing-misc/wellfounded.ml.principal.reference @@ -0,0 +1,7 @@ + +# type _ prod = Prod : ('a * 'y) prod +# Characters 87-96: + type d = d * d + ^^^^^^^^^ +Error: The type abbreviation d is cyclic +# diff --git a/testsuite/tests/typing-misc/wellfounded.ml.reference b/testsuite/tests/typing-misc/wellfounded.ml.reference new file mode 100644 index 000000000..0c9e64ad0 --- /dev/null +++ b/testsuite/tests/typing-misc/wellfounded.ml.reference @@ -0,0 +1,7 @@ + +# type _ prod = Prod : ('a * 'y) prod +# Characters 87-96: + type d = d * d + ^^^^^^^^^ +Error: The type abbreviation d is cyclic +# diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 9a77ce538..aa0e955af 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -523,7 +523,7 @@ let check_well_founded env loc path to_check ty = (* Will be detected by check_recursion *) Btype.backtrack snap in - check ty TypeSet.empty ty + Ctype.wrap_trace_gadt_instances env (check ty TypeSet.empty) ty let check_well_founded_manifest env loc path decl = if decl.type_manifest = None then () else |