Fix PR#6240

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/module-alias@14301 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -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:
 -------------

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

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);;*)

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
+# *   

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)) ->