Full fix for open F(X).A

lib/dep_zipper.ml

@@ -52,6 +52,7 @@ module Pre = struct
   let me_ext ~loc:_ _ = id
   let me_ident = id
   let me_val = id
+  let me_proj me _proj res = me + res
   let minor = id
   let mt_ext ~loc:_ _ = id
   let mt_fun arg y = match arg with

lib/longident_converter.ml

@@ -16,7 +16,7 @@ let me_from_lid x =
   let open M2l in
   let rec pathlike acc l : module_expr =
     match l with
-    | L.Lident s -> Ident (List.rev (s::acc))
+    | L.Lident s -> Ident (s::acc)
     | L.Ldot (lid,s) -> pathlike (s::acc) lid
     | L.Lapply (f,x) ->
       let app =  Apply {f=pathlike [] f; x=pathlike [] x} in

lib/zipper_def.ml

@@ -67,8 +67,11 @@ module type fold = sig
     module_type Arg.t option -> module_expr -> module_expr
   val me_ident : path -> module_expr
   val me_val : minors -> module_expr
+  val me_proj: module_expr -> Paths.S.t -> path -> module_expr
+
   val minor : minors -> expr
 
+
   val mt_ext : loc:Uloc.t -> string -> ext -> module_type
   val mt_fun :
     module_type Arg.t option -> module_type -> module_type
@@ -173,6 +176,7 @@ module type s = sig
     | Apply_left: M2l.module_expr -> M2l.module_expr me
     | Apply_right: module_expr -> M2l.module_expr me
     | Proj_left: Paths.Simple.t -> M2l.module_expr me
+    | Proj_right: module_expr * Paths.S.t -> path_in_context me
     | Fun_left: {name:Name.t option; diff:state_diff; body:M2l.module_expr} -> M2l.module_type me
     | Fun_right:
         (module_type Arg.t * state_diff ) option

lib/zipper_fold.ml

@@ -60,7 +60,6 @@ module Zip(F:Zdef.fold)(State:Sk.state) = struct
   let pack = user F.pack
   let expr_ext name = user_ml (F.expr_ext name)
   let me_ident = both Sk.ident F.me_ident
-  let me_proj _proj _me = assert false
   let apply param loc f =
     both2 (fun f x -> Sk.apply param loc ~f ~x) (F.apply loc) f
   let me_fun_none =  both (fun f -> Sk.fn ~f ~x:None) (F.me_fun None)
@@ -94,6 +93,13 @@ module Zip(F:Zdef.fold)(State:Sk.state) = struct
       user = F.path_expr_proj app_res.user proj proj_res.user
     }
 
+  let me_proj app_res proj proj_res =
+    {
+      backbone = Sk.ident proj_res.backbone;
+      user = F.me_proj app_res.user proj proj_res.user
+    }
+
+
   let with_type with_cstr cstrs =
     { backbone = cstrs.backbone; user = F.with_type with_cstr cstrs.user }
 
@@ -199,7 +205,7 @@ module Make(F:Zdef.fold)(Env:Stage.envt) = struct
       D.apply param ctx.uloc f
     | Proj {me=mep;proj} ->
       me (Me (Proj_left proj)::path) ~param ~ctx ~state mep >>=
-      D.me_proj proj
+      me_proj ~state path ~param ~ctx proj
     | Fun {arg = None; body } ->
       me (Me (Fun_right None) :: path) ~param ~ctx ~state body
       >>| D.me_fun_none
@@ -332,6 +338,11 @@ module Make(F:Zdef.fold)(Env:Stage.envt) = struct
         resolve path ?within:(Sk.signature res.backbone) ~state ~level ~ctx
           ~edge ~param proj
         >>| D.path_expr_proj res proj
+  and me_proj ~state path ~param ~ctx proj me =
+      let path = Me (Proj_right (me,proj)) :: path in
+      resolve path ?within:(Sk.signature me.backbone) ~state ~level:Module ~ctx
+        ~param proj
+      >>| D.me_proj me proj
   and path_expr ?edge ~level path ~ctx ~param ~state x = path_expr_gen
       ?edge ~level path ~ctx ~param ~state x
   and gen_minors path ~param ~ctx ~state left =
@@ -420,6 +431,8 @@ module Make(F:Zdef.fold)(Env:Stage.envt) = struct
         restart_path_expr ~param ~ctx ~state (path:Paths.Expr.t path) (D.path_expr_pure x)
      | Path_expr (Proj (app_res,proj)) :: path ->
         restart_path_expr ~param ~ctx ~state (path:Paths.Expr.t path) (D.path_expr_proj app_res proj x)
+      | Me (Proj_right (me,proj)) :: path ->
+        restart_me ~param ~ctx ~state (path:module_expr path) (D.me_proj me proj x)
      | With_constraint With_module {body;lhs; delete} :: path ->
        restart_with (path: M2l.with_constraint path) ~param ~state ~ctx
          (D.with_module ~delete ~lhs (D.me_ident x) body)
@@ -443,7 +456,8 @@ module Make(F:Zdef.fold)(Env:Stage.envt) = struct
     | Me(Apply_right fn) :: path ->
       restart_me path ~ctx ~param ~state (D.apply param ctx.uloc fn x)
     | Me (Proj_left proj) :: path ->
-      restart_me path ~ctx ~param ~state (D.me_proj proj x)
+      me_proj ~state path ~param ~ctx proj x >>=
+      restart_me path ~ctx ~param ~state
     | Me(Fun_right None) :: path ->
       restart_me path ~state ~ctx ~param (D.me_fun_none x)
     | Me(Fun_right Some (r,diff)) :: path ->

lib/zipper_pp.ml

@@ -57,6 +57,7 @@ module Make(Def:Zipper_def.s)(R:Result_printer with module T := Def.T) = struct
         )
     | Path_expr Proj (_app,_proj) :: rest ->
       path_expr (rest:Paths.Expr.t t) x
+    | Me Proj_right _  :: rest -> me rest x
     | With_constraint With_module {body;lhs; delete} :: rest ->
       with_constraint (rest: M2l.with_constraint t)
         (fp4 "%t with module %t %t %t"

lib/zipper_skeleton.ml

@@ -90,7 +90,6 @@ let str = P.simple
 
 let included param loc lvl e = T.gen_include param.T.policy loc lvl e
 
-
 let m_with dels mt = match mt.P.mty with
   | Module.Abstract _ | Module.Fun _ -> mt
   | Module.Sig s ->
@@ -182,7 +181,6 @@ module State(Env:Stage.envt) = struct
         Env.pp state.current Paths.S.pp path T.pp_answer x.main;
       Ok x
 
-
 end
 
 module type state = sig

tests/cases/module_type_expr.ml

@@ -0,0 +1,6 @@
+module type T = sig
+  module type s = module type of One.Make(Two)
+  module M : s
+  open M
+  open Three
+end

tests/cases/module_type_expr.ref

@@ -0,0 +1,17 @@
+[Notification]: cases/module_type_expr.ml:l2.2−46,
+a non-resolvable module, One, has been replaced by an approximation
+[Notification]: cases/module_type_expr.ml:l2.2−46,
+a non-resolvable module, Two, has been replaced by an approximation
+[Notification]: cases/module_type_expr.ml:l5.2−12,
+a non-resolvable module, Three, has been replaced by an approximation
+{
+"version" : [0, 11, 0],
+"dependencies" :
+  [{
+   "file" : "cases/module_type_expr.ml",
+   "deps" : [["Two"], ["Three"], ["One"]]
+   }],
+"local" :
+  [{ "module" : ["Module_type_expr"], "ml" : "cases/module_type_expr.ml" }],
+"unknown" : [["One"], ["Three"], ["Two"]]
+}

tests/cases/open_functor.ml

@@ -0,0 +1,9 @@
+module X = struct end
+
+module type T = sig
+  open One.Make(Two).Sub
+  open Three
+  module F(X:sig end): sig module Sub: sig module A: sig end end end
+  open F(X).Sub
+  open A
+end

tests/cases/open_functor.ref

@@ -0,0 +1,20 @@
+[Notification]: cases/open_functor.ml:l4.2−24,
+a non-resolvable module, One, has been replaced by an approximation
+[Notification]: cases/open_functor.ml:l4.2−24,
+a non-resolvable module, Two, has been replaced by an approximation
+[Notification]: cases/open_functor.ml:l5.2−12,
+a non-resolvable module, Three, has been replaced by an approximation
+[Warning]: cases/open_functor.ml:l7.2−15, name resolution for X was
+ambiguous, due to the opening of the external module Three, at
+location l5.2−12. Spurious dependencies might be inferred due to this
+ambiguity.
+{
+"version" : [0, 11, 0],
+"dependencies" :
+  [{
+   "file" : "cases/open_functor.ml",
+   "deps" : [["Two"], ["Three"], ["One"]]
+   }],
+"local" : [{ "module" : ["Open_functor"], "ml" : "cases/open_functor.ml" }],
+"unknown" : [["One"], ["Three"], ["Two"]]
+}

tests/step_by_step.ml

@@ -56,7 +56,8 @@ let () =
     Read.file {Read.format=Read.Src; kind=M2l.Structure} file in
   let m2l =
     match res with
-    | Error _ -> Format.eprintf "Error at parsing.@."; exit 2
+    | Error (Ocaml _) -> Format.eprintf "Error when parsing source %a.@." Unitname.pp name; exit 2
+    | Error (Serialized _) -> Format.eprintf "Error when parsing m2l %a.@." Unitname.pp name; exit 2
     | Ok x -> x in
   let env =   Envt.start ~open_approximation:true
     ~libs:[]