typing: fix a try_expand_once forgotten from ocaml#10170

On OCaml versions 5.1 and older, this caused a Ctype.Escape(_)
uncaught exception on the included test case.

Reported-by: Neven Villani <vanille@crans.org>

Changes

@@ -2429,6 +2429,10 @@ OCaml 4.14 maintenance version
 - #12878: fix incorrect treatment of injectivity for private recursive types.
   (Jeremy Yallop, review by Gabriel Scherer and Jacques Garrigue)
 
+- #12971, #12974: fix an uncaught Ctype.Escape exception on some
+  invalid programs forming recursive types.
+  (Gabriel Scherer, review by Florian Angeletti, report by Neven Villani)
+
 - #12264, #12289: Fix compact_allocate to avoid a pathological case
   that causes very slow compaction.
   (Damien Doligez, report by Arseniy Alekseyev, review by Sadiq Jaffer)

testsuite/tests/typing-misc-bugs/pr12971.compilers.reference

@@ -0,0 +1,9 @@
+module Seq :
+  sig
+    type 'a t = unit -> 'a node
+    and 'a node
+    val empty : 'a t
+    val cons : 'a -> 'a t -> 'a t
+  end
+type 'a t = T of 'a
+val wrong_to_seq : ('a Seq.t as 'a) Seq.t t -> 'a Seq.t Seq.t

testsuite/tests/typing-misc-bugs/pr12971.ml

@@ -0,0 +1,32 @@
+(* TEST_BELOW *)
+
+module Seq : sig
+  type 'a t = unit -> 'a node
+  and 'a node
+
+  val empty : 'a t
+  val cons : 'a -> 'a t -> 'a t
+end = struct
+  type 'a t = unit -> 'a node
+  and 'a node = unit
+
+  let empty () = ()
+  let cons x xs () = ()
+end
+
+type 'a t = T of 'a
+
+(* Note: the current behavior of this function is believed to be
+   a bug, in the sense that it creates an equi-recursive type even in
+   absence of the -rectypes flag. On the other hand, it does not fail
+   with the Ctype.Escape exception, as it did from 4.13 to 5.1. *)
+let wrong_to_seq (xt : 'a t) : 'a Seq.t =
+  let T x = xt in
+  Seq.cons Seq.empty x
+
+(* TEST
+ ocamlc_flags = "-i";
+ setup-ocamlc.byte-build-env;
+ ocamlc.byte;
+ check-ocamlc.byte-output;
+*)

testsuite/tests/typing-misc-bugs/pr12971_bis.compilers.reference

@@ -0,0 +1,6 @@
+File "pr12971_bis.ml", line 17, characters 12-48:
+17 | let strange x = Seq.[cons x empty; cons empty x]
+                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type "('a Seq.t as 'a) Seq.t -> 'a Seq.t Seq.t list"
+       but an expression was expected of type
+         "('a Seq.t as 'a) Seq.t -> 'a Seq.t Seq.t list"

testsuite/tests/typing-misc-bugs/pr12971_bis.ml

@@ -0,0 +1,25 @@
+(* TEST_BELOW *)
+
+module Seq : sig
+  type 'a t = unit -> 'a node
+  and 'a node
+
+  val empty : 'a t
+  val cons : 'a -> 'a t -> 'a t
+end = struct
+  type 'a t = unit -> 'a node
+  and 'a node = unit
+
+  let empty () = ()
+  let cons x xs () = ()
+end
+
+let strange x = Seq.[cons x empty; cons empty x]
+
+(* TEST
+ ocamlc_byte_exit_status = "2";
+ ocamlc_flags = "-i";
+ setup-ocamlc.byte-build-env;
+ ocamlc.byte;
+ check-ocamlc.byte-output;
+*)

typing/ctype.ml

@@ -1841,7 +1841,7 @@ let rec occur_rec env allow_recursive visited ty0 ty =
         let visited = TypeSet.add ty visited in
         iter_type_expr (occur_rec env allow_recursive visited ty0) ty
       with Occur -> try
-        let ty' = try_expand_head try_expand_once env ty in
+        let ty' = try_expand_head try_expand_safe env ty in
         (* This call used to be inlined, but there seems no reason for it.
            Message was referring to change in rev. 1.58 of the CVS repo. *)
         occur_rec env allow_recursive visited ty0 ty'