From 3b9c7e7045f202069d9d1faa31ec817f94add378 Mon Sep 17 00:00:00 2001
From: Ryan Tjoa <rtjoa@janestreet.com>
Date: Mon, 30 Dec 2024 03:41:48 -0500
Subject: [PATCH] More tests

---
 .../recursive.ml                              | 93 +++++++++++++++++++
 1 file changed, 93 insertions(+)

diff --git a/testsuite/tests/typing-layouts-unboxed-records/recursive.ml b/testsuite/tests/typing-layouts-unboxed-records/recursive.ml
index 920c11c743..768be3e91e 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/recursive.ml
+++ b/testsuite/tests/typing-layouts-unboxed-records/recursive.ml
@@ -19,6 +19,57 @@ type t = #{ tl: t list }
 type t = #{ tl : t list; }
 |}]
 
+module AbstractList : sig
+  type 'a t
+end = struct
+  type 'a t = Cons of 'a * 'a list | Nil
+end
+[%%expect{|
+module AbstractList : sig type 'a t end
+|}]
+
+type t = #{ tl: t AbstractList.t }
+[%%expect{|
+type t = #{ tl : t AbstractList.t; }
+|}]
+
+type 'a mylist = Cons of 'a * 'a list | Nil
+and t = { t : t mylist } [@@unboxed]
+[%%expect{|
+type 'a mylist = Cons of 'a * 'a list | Nil
+and t = { t : t mylist; } [@@unboxed]
+|}]
+
+(* This passes the unboxed recursion check (as [pair] always has jkind
+   [value & value], [(int, bad) pair] is indeed finite-size, but it fails the
+   jkind check *)
+type ('a, 'b) pair = #{ a : 'a ; b : 'b }
+type bad = #{ bad : (int, bad) pair }
+[%%expect{|
+type ('a, 'b) pair = #{ a : 'a; b : 'b; }
+Line 2, characters 0-37:
+2 | type bad = #{ bad : (int, bad) pair }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error:
+       The layout of bad is value & value
+         because of the definition of pair at line 1, characters 0-41.
+       But the layout of bad must be a sublayout of value
+         because of the definition of pair at line 1, characters 0-41.
+|}]
+
+(* This fails the unboxed recursion check; we must look into [pair] since it's
+   part of the same mutually recursive type decl. *)
+type ('a, 'b) pair = #{ a : 'a ; b : 'b }
+and bad = #{ bad : (int, bad) pair }
+[%%expect{|
+Line 2, characters 0-36:
+2 | and bad = #{ bad : (int, bad) pair }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "(int, bad) pair",
+         "(int, bad) pair" contains "bad"
+|}]
+
 (* Guarded by a function *)
 type t = #{ f1 : t -> t ; f2 : t -> t }
 [%%expect{|
@@ -91,6 +142,17 @@ Error: The definition of "bad" is recursive without boxing:
          "bad" contains "bad"
 |}]
 
+type bad = #{ x : #(int * u) }
+and u = T of bad [@@unboxed]
+[%%expect{|
+Line 1, characters 0-30:
+1 | type bad = #{ x : #(int * u) }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "u",
+         "u" contains "bad"
+|}]
+
 type 'a record_id = #{ a : 'a }
 type 'a alias_id = 'a
 [%%expect{|
@@ -247,6 +309,30 @@ Error: Unboxed record element types must have a representable layout.
          because it is the type of record field b.
 |}]
 
+(* Make sure we look through [as] types *)
+
+type 'a t = #{ x: ('a s as 'm) list ; m : 'm }
+and 'b s = #{ x : 'b t }
+[%%expect{|
+Line 1, characters 0-46:
+1 | type 'a t = #{ x: ('a s as 'm) list ; m : 'm }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "t" is recursive without boxing:
+         "'a t" contains "'a s",
+         "'a s" contains "'a t"
+|}]
+
+type 'a t = #{ x: ('a s as 'm) }
+and 'b s = #{ x : 'b t }
+[%%expect{|
+Line 1, characters 0-32:
+1 | type 'a t = #{ x: ('a s as 'm) }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "t" is recursive without boxing:
+         "'a t" contains "'a s",
+         "'a s" contains "'a t"
+|}]
+
 (***************************************)
 (* Singleton recursive unboxed records *)
 
@@ -257,6 +343,13 @@ type 'a safe = #{ a : 'a; }
 type x = int safe safe
 |}]
 
+type 'a id = 'a
+type x = #{ x : x id }
+[%%expect{|
+type 'a id = 'a
+type x = #{ x : x id; }
+|}]
+
 (* CR layouts v7.2: allow bounded repetition of the same type constructor of
    unboxed records. *)
 type 'a safe = #{ a : 'a }