diff --git a/testsuite/tests/typing-local/regression_class_dep.ml b/testsuite/tests/typing-local/regression_class_dep.ml new file mode 100644 index 00000000000..dcd2a6aeebb --- /dev/null +++ b/testsuite/tests/typing-local/regression_class_dep.ml @@ -0,0 +1,9 @@ +class c = + object + method private m () () = 0 + end + +class virtual cv = + object + method virtual private m : unit -> unit -> int + end diff --git a/testsuite/tests/typing-local/regression_class_type.ml b/testsuite/tests/typing-local/regression_class_type.ml new file mode 100644 index 00000000000..d0c6803e294 --- /dev/null +++ b/testsuite/tests/typing-local/regression_class_type.ml @@ -0,0 +1,18 @@ +(* TEST +readonly_files = "regression_class_dep.ml" +* setup-ocamlc.opt-build-env +** ocamlc.opt +module = "regression_class_dep.ml" +*** ocamlc.opt +module = "" +flags = "-c" +*) + +(* https://github.com/ocaml-flambda/ocaml-jst/issues/65 *) + +module Dep = Regression_class_dep +class c fname = + object + inherit Dep.c + inherit Dep.cv + end diff --git a/typing/ctype.ml b/typing/ctype.ml index 75ab9412424..0278829507b 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -5214,6 +5214,7 @@ let rec nongen_schema_rec env ty = (* Return whether all variables of type [ty] are generic. *) let nongen_schema env ty = + remove_mode_variables ty; visited := TypeSet.empty; try nongen_schema_rec env ty; diff --git a/typing/ctype.mli b/typing/ctype.mli index f900d8a72ce..1c79256e2fd 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -398,11 +398,12 @@ val remove_mode_variables: type_expr -> unit val nongen_schema: Env.t -> type_expr -> bool (* Check whether the given type scheme contains no non-generic - type variables *) + type variables, and ensure mode variables are fully determined *) val nongen_class_declaration: class_declaration -> bool (* Check whether the given class type contains no non-generic - type variables. Uses the empty environment. *) + type variables, and ensures mode variables are fully determined. + Uses the empty environment. *) val free_variables: ?env:Env.t -> type_expr -> type_expr list (* If env present, then check for incomplete definitions too *) diff --git a/typing/typemod.ml b/typing/typemod.ml index 2684f80d33d..abef4d95550 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -1938,17 +1938,13 @@ and nongen_signature_item env f = function | Sig_module(_id, _, md, _, _) -> nongen_modtype env f md.md_type | _ -> false -let nongen_ty env ty = - Ctype.remove_mode_variables ty; - Ctype.nongen_schema env ty - let check_nongen_signature_item env sig_item = match sig_item with Sig_value(_id, vd, _) -> - if nongen_ty env vd.val_type then + if Ctype.nongen_schema env vd.val_type then raise (Error (vd.val_loc, env, Non_generalizable vd.val_type)) | Sig_module (_id, _, md, _, _) -> - if nongen_modtype env nongen_ty md.md_type then + if nongen_modtype env Ctype.nongen_schema md.md_type then raise(Error(md.md_loc, env, Non_generalizable_module md.md_type)) | _ -> () @@ -2983,7 +2979,7 @@ let type_module_type_of env smod = in let mty = Mtype.scrape_for_type_of ~remove_aliases env tmty.mod_type in (* PR#5036: must not contain non-generalized type variables *) - if nongen_modtype env nongen_ty mty then + if nongen_modtype env Ctype.nongen_schema mty then raise(Error(smod.pmod_loc, env, Non_generalizable_module mty)); tmty, mty