diff --git a/ocaml/testsuite/tests/typing-signatures/nondep_regression.ml b/ocaml/testsuite/tests/typing-signatures/nondep_regression.ml new file mode 100644 index 00000000000..76033b3c4e3 --- /dev/null +++ b/ocaml/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/ocaml/typing/btype.ml b/ocaml/typing/btype.ml index 0930adfc390..37b4e4f2b6f 100644 --- a/ocaml/typing/btype.ml +++ b/ocaml/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/ocaml/typing/btype.mli b/ocaml/typing/btype.mli index 22cef4e065b..8655ac85407 100644 --- a/ocaml/typing/btype.mli +++ b/ocaml/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/ocaml/typing/ctype.ml b/ocaml/typing/ctype.ml index 9d495ac7007..ad564c1850e 100644 --- a/ocaml/typing/ctype.ml +++ b/ocaml/typing/ctype.ml @@ -5420,7 +5420,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 @@ -5481,9 +5481,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