Fix PR#5907

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13280 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -103,6 +103,7 @@ Bug fixes:
 - PR#5891: support rectypes tag for mlpack (ocamlbuild)
 - PR#5892: GADT exhaustiveness check is broken
 - PR#5906: GADT exhaustiveness check is still broken
+- PR#5907: Undetected cycle during typecheck causes exceptions
 
 OCaml 4.00.1:
 -------------

testsuite/tests/typing-misc/occur_check.ml

@@ -0,0 +1,5 @@
+(* PR#5907 *)
+
+type 'a t = 'a;;
+let f (g : 'a list -> 'a t -> 'a) s = g s s;;
+let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;;

testsuite/tests/typing-misc/occur_check.ml.reference

@@ -0,0 +1,15 @@
+
+#     type 'a t = 'a
+# Characters 42-43:
+  let f (g : 'a list -> 'a t -> 'a) s = g s s;;
+                                            ^
+Error: This expression has type 'a list
+       but an expression was expected of type 'a t = 'a
+       The type variable 'a occurs inside 'a list
+# Characters 42-43:
+  let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;;
+                                            ^
+Error: This expression has type 'a * 'b
+       but an expression was expected of type 'a t = 'a
+       The type variable 'a occurs inside 'a * 'b
+# 

typing/ctype.ml

@@ -2105,7 +2105,7 @@ let unify_eq env t1 t2 =
 
 let rec unify (env:Env.t ref) t1 t2 =
   (* First step: special cases (optimizations) *)
-  if unify_eq !env t1 t2 then () else
+  if t1 == t2 then () else
   let t1 = repr t1 in
   let t2 = repr t2 in
   if unify_eq !env t1 t2 then () else
@@ -2200,11 +2200,11 @@ and unify3 env t1 t1' t2 t2' =
       unify_univar t1' t2' !univar_pairs;
       link_type t1' t2'
   | (Tvar _, _) ->
-      occur !env t1 t2';
+      occur !env t1' t2;
       occur_univar !env t2;
       link_type t1' t2;
   | (_, Tvar _) ->
-      occur !env t2 t1';
+      occur !env t2' t1;
       occur_univar !env t1;
       link_type t2' t1;
   | (Tfield _, Tfield _) -> (* special case for GADTs *)