diff options
| -rw-r--r-- | testsuite/tests/typing-modules/aliases.ml | 9 | ||||
| -rw-r--r-- | testsuite/tests/typing-modules/aliases.ml.reference | 7 | ||||
| -rw-r--r-- | typing/env.ml | 12 | ||||
| -rw-r--r-- | typing/typemod.ml | 18 |
4 files changed, 41 insertions, 5 deletions
diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml index 19964edee..fd7344fa0 100644 --- a/testsuite/tests/typing-modules/aliases.ml +++ b/testsuite/tests/typing-modules/aliases.ml @@ -97,3 +97,12 @@ module S = String module StringSet = Set.Make(String) module SSet = Set.Make(S);; let f (x : StringSet.t) = (x : SSet.t);; + +(* Also using include (cf. Leo's mail 2013-11-16) *) +module F (M : sig end) : sig type t end = struct type t = int end +module T = struct + module M = struct end + include F(M) +end;; +include T;; +let f (x : t) : T.t = x ;; diff --git a/testsuite/tests/typing-modules/aliases.ml.reference b/testsuite/tests/typing-modules/aliases.ml.reference index f92a6a73b..a3414d0a5 100644 --- a/testsuite/tests/typing-modules/aliases.ml.reference +++ b/testsuite/tests/typing-modules/aliases.ml.reference @@ -64,7 +64,7 @@ Error: Signature mismatch: # - : int = 1 # module M'' : sig module N' : sig val x : int end end # - : int = 1 -# module M2 : sig module N : sig val x : int end module N' = N end +# module M2 : sig module N = M'.N module N' = M'.N' end # module M3 : sig module N' : sig val x : int end end # - : int = 1 # module M3' : sig module N' : sig val x : int end end @@ -207,4 +207,9 @@ module SSet : val of_list : elt list -> t end # val f : StringSet.t -> SSet.t = <fun> +# module F : functor (M : sig end) -> sig type t end +module T : sig module M : sig end type t = F(M).t end +# module M = T.M +type t = F(M).t +# val f : t -> T.t = <fun> # diff --git a/typing/env.ml b/typing/env.ml index cd98b3104..e7d15ca13 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -553,10 +553,14 @@ let find_modtype_expansion path env = | None -> raise Not_found | Some mty -> mty -let is_functor_arg path env = - let id = Path.head path in - try Ident.find_same id env.functor_args; true - with Not_found -> false +let rec is_functor_arg path env = + match path with + Pident id -> + begin try Ident.find_same id env.functor_args; true + with Not_found -> false + end + | Pdot (p, s, _) -> is_functor_arg p env + | Papply _ -> true (* Lookup by name *) diff --git a/typing/typemod.ml b/typing/typemod.ml index 2070ab7ec..55b95ada8 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -1247,6 +1247,24 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = (* Rename all identifiers bound by this signature to avoid clashes *) let sg = Subst.signature Subst.identity (extract_sig_open env smodl.pmod_loc modl.mod_type) in + let sg = + match modl.mod_desc with + Tmod_ident (p, _) when not (Env.is_functor_arg p env) -> + let pos = ref 0 in + List.map + (function + | Sig_module (id, md, rs) -> + let n = !pos in incr pos; + Sig_module (id, {md with md_type = + Mty_alias (Pdot(p,Ident.name id,n))}, + rs) + | Sig_value _ | Sig_exception _ | Sig_class _ as it -> + incr pos; it + | Sig_type _ | Sig_modtype _ | Sig_class_type _ as it -> + it) + sg + | _ -> sg + in List.iter (check_sig_item type_names module_names modtype_names loc) sg; let new_env = Env.add_signature sg env in |