Bugfix for Ctype.nondep_type (#11879)

5 files changed, 30 insertions, 4 deletions

diff --git a/Changes b/Changes
index 5c7060f82c..56e2a0d2e8 100644
--- a/Changes
+++ b/Changes
@@ -61,6 +61,9 @@ Working version
   would previous behave incorrectly, and now results in a clean error.
   (Leo White, review by Gabriel Scherer and Florian Angeletti)
 
+- #11879: Bugfix for Ctype.nondep_type
+  (Stephen Dolan, review by Gabriel Scherer)
+
 ### Code generation and optimizations:
 
 - #8998, #11321, #11430: change mangling of OCaml long identifiers
diff --git a/testsuite/tests/typing-signatures/nondep_regression.ml b/testsuite/tests/typing-signatures/nondep_regression.ml
new file mode 100644
index 0000000000..76033b3c4e
--- /dev/null
+++ b/testsuite/tests/typing-signatures/nondep_regression.ml
@@ -0,0 +1,17 @@
+(* TEST
+   * expect
+*)
+
+type 'a seq = 'a list
+
+module Make (A : sig type t end) = struct
+  type t = A.t seq
+end
+
+module H = Make (struct type t end)
+
+[%%expect{|
+type 'a seq = 'a list
+module Make : functor (A : sig type t end) -> sig type t = A.t seq end
+module H : sig type t end
+|}]
diff --git a/typing/btype.ml b/typing/btype.ml
index 6e742771d1..7ac1aff412 100644
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -47,6 +47,7 @@ module TransientTypeHash = Hashtbl.Make(TransientTypeOps)
 module TypeHash = struct
   include TransientTypeHash
   let add hash = wrap_repr (add hash)
+  let remove hash = wrap_repr (remove hash)
   let find hash = wrap_repr (find hash)
   let iter f = TransientTypeHash.iter (wrap_type_expr f)
 end
diff --git a/typing/btype.mli b/typing/btype.mli
index f051e777a4..18f7c750a8 100644
--- a/typing/btype.mli
+++ b/typing/btype.mli
@@ -40,6 +40,7 @@ end
 module TypeHash : sig
   include Hashtbl.S with type key = transient_expr
   val add: 'a t -> type_expr -> 'a -> unit
+  val remove : 'a t -> type_expr -> unit
   val find: 'a t -> type_expr -> 'a
   val iter: (type_expr -> 'a -> unit) -> 'a t -> unit
 end
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 39d8d14258..119822caea 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -5139,7 +5139,7 @@ let rec nondep_type_rec ?(expand_private=false) env ids ty =
   with Not_found ->
     let ty' = newgenstub ~scope:(get_scope ty) in
     TypeHash.add nondep_hash ty ty';
-    let desc =
+    match
       match get_desc ty with
       | Tconstr(p, tl, _abbrev) as desc ->
           begin try
@@ -5200,9 +5200,13 @@ let rec nondep_type_rec ?(expand_private=false) env ids ty =
             | _ -> Tvariant row
           end
       | desc -> copy_type_desc (nondep_type_rec env ids) desc
-    in
-    Transient_expr.set_stub_desc ty' desc;
-    ty'
+    with
+    | desc ->
+      Transient_expr.set_stub_desc ty' desc;
+      ty'
+    | exception e ->
+      TypeHash.remove nondep_hash ty;
+      raise e
 
 let nondep_type env id ty =
   try