diff options
| -rw-r--r-- | Changes | 1 | ||||
| -rw-r--r-- | testsuite/tests/typing-modules-bugs/pr6240_ok.ml | 11 | ||||
| -rw-r--r-- | testsuite/tests/typing-modules/aliases.ml | 24 | ||||
| -rw-r--r-- | testsuite/tests/typing-modules/aliases.ml.reference | 51 | ||||
| -rw-r--r-- | typing/includemod.ml | 8 |
5 files changed, 92 insertions, 3 deletions
@@ -47,6 +47,7 @@ OCaml 4.01.1: Bug fixes: - PR#6173: Typing error message is worse that before +- PR#6240: Fail to expand module type abbreviation during substyping OCaml 4.01.0: ------------- diff --git a/testsuite/tests/typing-modules-bugs/pr6240_ok.ml b/testsuite/tests/typing-modules-bugs/pr6240_ok.ml new file mode 100644 index 000000000..de1754aa0 --- /dev/null +++ b/testsuite/tests/typing-modules-bugs/pr6240_ok.ml @@ -0,0 +1,11 @@ +module M : sig + module type T + module F (X : T) : sig end +end = struct + module type T = sig end + module F (X : T) = struct end +end + +module type T = M.T + +module F : functor (X : T) -> sig end = M.F diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml index fd7344fa0..1c651c4a8 100644 --- a/testsuite/tests/typing-modules/aliases.ml +++ b/testsuite/tests/typing-modules/aliases.ml @@ -106,3 +106,27 @@ module T = struct end;; include T;; let f (x : t) : T.t = x ;; + +(* PR#4049 *) +(* This works thanks to abbreviations *) +module A = struct + module B = struct type t let compare x y = 0 end + module S = Set.Make(B) + let empty = S.empty +end +module A1 = A;; +A1.empty = A.empty;; + +(* PR#3476 *) +(* Does not work yet *) +module FF(X : sig end) = struct type t end +module M = struct + module X = struct end + module Y = FF (X) (* XXX *) + type t = Y.t +end +module F (Y : sig type t end) (M : sig type t = Y.t end) = struct end;; + +module G = F (M.Y);; +(*module N = G (M);; +module N = F (M.Y) (M);;*) diff --git a/testsuite/tests/typing-modules/aliases.ml.reference b/testsuite/tests/typing-modules/aliases.ml.reference index a3414d0a5..723f9ef46 100644 --- a/testsuite/tests/typing-modules/aliases.ml.reference +++ b/testsuite/tests/typing-modules/aliases.ml.reference @@ -212,4 +212,53 @@ 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> -# +# module A : + sig + module B : sig type t val compare : 'a -> 'b -> int end + module S : + sig + type elt = B.t + type t = Set.Make(B).t + val empty : t + val is_empty : t -> bool + val mem : elt -> t -> bool + val add : elt -> t -> t + val singleton : elt -> t + val remove : elt -> t -> t + val union : t -> t -> t + val inter : t -> t -> t + val diff : t -> t -> t + val compare : t -> t -> int + val equal : t -> t -> bool + val subset : t -> t -> bool + val iter : (elt -> unit) -> t -> unit + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + val for_all : (elt -> bool) -> t -> bool + val exists : (elt -> bool) -> t -> bool + val filter : (elt -> bool) -> t -> t + val partition : (elt -> bool) -> t -> t * t + val cardinal : t -> int + val elements : t -> elt list + val min_elt : t -> elt + val max_elt : t -> elt + val choose : t -> elt + val split : elt -> t -> t * bool * t + val find : elt -> t -> elt + val of_list : elt list -> t + end + val empty : S.t + end +module A1 = A +# - : bool = true +# module FF : functor (X : sig end) -> sig type t end +module M : + sig + module X : sig end + module Y : sig type t = FF(X).t end + type t = Y.t + end +module F : + functor (Y : sig type t end) -> + functor (M : sig type t = Y.t end) -> sig end +# module G : functor (M : sig type t = M.Y.t end) -> sig end +# * diff --git a/typing/includemod.ml b/typing/includemod.ml index a63002590..3ebe9c76d 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -95,6 +95,10 @@ let class_declarations env cxt subst id decl1 decl2 = exception Dont_match +let may_expand_module_path env path = + try ignore (Env.find_modtype_expansion path env); true + with Not_found -> false + let expand_module_path env cxt path = try Env.find_modtype_expansion path env @@ -185,10 +189,10 @@ and try_modtypes env cxt subst mty1 mty2 = in let mty1 = Mtype.strengthen env (expand_module_alias env cxt p1) p1 in Tcoerce_alias (p1, modtypes env cxt subst mty1 mty2) + | (Mty_ident p1, _) when may_expand_module_path env p1 -> + try_modtypes env cxt subst (expand_module_path env cxt p1) mty2 | (_, Mty_ident p2) -> try_modtypes2 env cxt mty1 (Subst.modtype subst mty2) - | (Mty_ident p1, _) -> - try_modtypes env cxt subst (expand_module_path env cxt p1) mty2 | (Mty_signature sig1, Mty_signature sig2) -> signatures env cxt subst sig1 sig2 | (Mty_functor(param1, arg1, res1), Mty_functor(param2, arg2, res2)) -> |