module translation + bad functor example

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

3 files changed, 20 insertions, 11 deletions

diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index f244ea5d49..2987f9e097 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -250,6 +250,9 @@ let rec bound_value_identifiers = function
 (* Compile a module expression *)
 
 let rec transl_module cc rootpath mexp =
+  match mexp.mod_type with
+    Mty_alias _ -> lambda_unit
+  | _ ->
   match mexp.mod_desc with
     Tmod_ident (path,_) ->
       apply_coercion cc (transl_ident_path mexp.mod_env path)
@@ -513,11 +516,7 @@ let transl_store_structure glob map prims str =
                              transl_store rootpath (add_ident true id subst)
                                           rem)))
   | Tstr_module{mb_id=id; mb_expr=modl} ->
-      let lam =
-        match modl.mod_type with
-          Mty_alias _ -> lambda_unit
-        | _ -> transl_module Tcoerce_none (field_path rootpath id) modl
-      in
+      let lam = transl_module Tcoerce_none (field_path rootpath id) modl in
       (* Careful: the module value stored in the global may be different
          from the local module value, in case a coercion is applied.
          If so, keep using the local module value (id) in the remainder of
@@ -716,11 +715,7 @@ let transl_toplevel_item item =
       (* we need to use the unique name for the module because of issues
          with "open" (PR#1672) *)
       set_toplevel_unique_name id;
-      let lam =
-        match modl.mod_type with
-          Mty_alias _ -> lambda_unit
-        | _ -> transl_module Tcoerce_none (Some(Pident id)) modl
-      in
+      let lam = transl_module Tcoerce_none (Some(Pident id)) modl in
       toploop_setvalue id lam
   | Tstr_recmodule bindings ->
       let idents = List.map (fun mb -> mb.mb_id) bindings in
diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml
index 0821572ac5..65e1504e27 100644
--- a/testsuite/tests/typing-modules/aliases.ml
+++ b/testsuite/tests/typing-modules/aliases.ml
@@ -7,3 +7,18 @@ module C' : module type of Char = C;;
 module C'' : (module C) = C';; (* fails *)
 
 module C'' : (module Char) = C;;
+
+let f x = let module M = struct module L = List end in M.L.length x;;
+let g x = let module L = List in L.length (L.map succ x);;
+
+module F(X:sig end) = Char;;
+module C3 = F(struct end);;
+
+module G(X:sig end) = X;;
+module M = G(struct end);; (* must fix *)
+
+module M' = struct
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+M'.N'.x;;
diff --git a/typing/typecore.ml b/typing/typecore.ml
index d75f548eb3..42b1da7c46 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -2614,7 +2614,6 @@ and type_expect_ ?in_function env sexp ty_expected =
       let context = Typetexp.narrow () in
       let modl = !type_module env smodl in
       let (id, new_env) = Env.enter_module name.txt modl.mod_type env in
-      
       Ctype.init_def(Ident.current_time());
       Typetexp.widen context;
       let body = type_expect new_env sbody ty_expected in