use a strengthening version of scrape_alias in Typemod

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

testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml

@@ -0,0 +1,23 @@
+module Std = struct module Hash = Hashtbl end;;
+
+open Std;;
+module Hash1 : module type of Hash = Hash;;
+module Hash2 : sig include (module type of Hash) end = Hash;;
+let f1 (x : (_,_) Hash1.t) = (x : (_,_) Hashtbl.t);;
+
+(* original report required Core_kernel:
+module type S = sig
+open Core_kernel.Std
+
+module Hashtbl1 : module type of Hashtbl
+module Hashtbl2 : sig
+  include (module type of Hashtbl)
+end
+
+module Coverage : Core_kernel.Std.Hashable
+
+type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t
+type doesnt_type = unit
+  constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
+end
+*)

typing/env.mli

@@ -244,6 +244,3 @@ val fold_classs:
 val fold_cltypes:
   (string -> Path.t -> class_type_declaration -> 'a -> 'a) ->
   Longident.t option -> t -> 'a -> 'a
-
-(** Utilities *)
-val scrape_alias: t -> module_type -> module_type

typing/typemod.ml

@@ -54,13 +54,34 @@ let rec path_concat head p =
 
 (* Extract a signature from a module type *)
 
+(* see also Env.scrape_alias *)
+let rec scrape_alias_sttn env ?path mty =
+  match mty, path with
+    Mty_ident path, _ ->
+      begin try
+        scrape_alias_sttn env (Env.find_modtype_expansion path env)
+      with Not_found -> mty
+      end
+  | Mty_alias path, _ ->
+      begin try
+        scrape_alias_sttn env (Env.find_module path env).md_type ~path
+      with Not_found ->
+        Location.prerr_warning Location.none 
+          (Warnings.Deprecated
+             ("module " ^ Path.name path ^ " cannot be accessed"));
+        mty
+      end
+  | mty, Some path ->
+      Mtype.strengthen env mty path
+  | _ -> mty
+
 let extract_sig env loc mty =
-  match Env.scrape_alias env mty with
+  match scrape_alias_sttn env mty with
     Mty_signature sg -> sg
   | _ -> raise(Error(loc, env, Signature_expected))
 
 let extract_sig_open env loc mty =
-  match Env.scrape_alias env mty with
+  match scrape_alias_sttn env mty with
     Mty_signature sg -> sg
   | _ -> raise(Error(loc, env, Structure_expected mty))
 
@@ -997,7 +1018,7 @@ let rec type_module ?(alias=false) sttn funct_body anchor env smod =
       let path = try Some (path_of_module arg) with Not_a_path -> None in
       let funct =
         type_module (sttn && path <> None) funct_body None env sfunct in
-      begin match Env.scrape_alias env funct.mod_type with
+      begin match scrape_alias_sttn env funct.mod_type with
         Mty_functor(param, mty_param, mty_res) as mty_functor ->
           let coercion =
             try