More module type of fixes

src/xref2/compile.ml

@@ -67,8 +67,9 @@ and content env id =
       let sg' = Type_of.signature env sg in
       Tools.reset_caches ();
       if !Type_of.again
-      then loop sg'
-      else sg' in
+      then begin
+        if sg' = sg then sg else loop sg'
+      end else sg' in
     let sg = loop m in
     Module (signature env (id :> Id.Signature.t) sg)
   | Pack _ -> failwith "Unhandled content"
@@ -513,7 +514,9 @@ and module_type_expr :
       | Ok (_, _, ce) ->
           let e = Lang_of.simple_expansion Lang_of.empty id ce in
           Some (simple_expansion env id e)
-      | Error _ -> None
+      | Error e ->
+        Errors.report ~what:(`Module_type_expr ce) ~tools_error:e `Expand;
+        None
   in
   match expr with
   | Signature s -> Signature (signature env id s)

src/xref2/component.ml

@@ -632,6 +632,11 @@ module Fmt = struct
     | Some x -> Format.fprintf ppf "= %a" module_type_expr x
     | None -> ()
 
+  and module_type_type_of_desc ppf t =
+    match t with
+    | ModuleType.ModPath p -> Format.fprintf ppf "module type of %a" module_path p
+    | StructInclude p -> Format.fprintf ppf "module type of struct include %a end" module_path p
+
   and u_module_type_expr ppf mt =
     let open ModuleType.U in
     match mt with
@@ -640,8 +645,7 @@ module Fmt = struct
     | With (subs, e) ->
       Format.fprintf ppf "%a with [%a]" u_module_type_expr e
         substitution_list subs
-    | TypeOf { t_desc = ModPath p; _ }-> Format.fprintf ppf "module type of %a" module_path p
-    | TypeOf { t_desc = StructInclude p; _ } -> Format.fprintf ppf "module type of struct include %a end" module_path p
+    | TypeOf { t_desc; _ } -> module_type_type_of_desc ppf t_desc
 
   and module_type_expr ppf mt =
     let open ModuleType in

src/xref2/component.mli

@@ -489,6 +489,8 @@ module Fmt : sig
 
   val simple_expansion : Format.formatter -> ModuleType.simple_expansion -> unit
 
+  val module_type_type_of_desc : Format.formatter -> ModuleType.type_of_desc -> unit
+
   val u_module_type_expr : Format.formatter -> ModuleType.U.expr -> unit
 
   val module_type_expr : Format.formatter -> ModuleType.expr -> unit

src/xref2/errors.ml

@@ -14,7 +14,9 @@ module Tools_error = struct
       (** The module signature depends upon a forward path *)
     | `UnresolvedPath of
       [ `Module of Cpath.module_ | `ModuleType of Cpath.module_type ]
-      (** The path to the module or module type could not be resolved *) ]
+      (** The path to the module or module type could not be resolved *)
+    | `UnexpandedTypeOf of Component.ModuleType.type_of_desc
+      (** The `module type of` expression could not be expanded *) ]
 
   type simple_module_lookup_error =
     [ `Local of Env.t * Ident.path_module
@@ -110,6 +112,10 @@ module Tools_error = struct
     | `ApplyNotFunctor -> Format.fprintf fmt "Apply module is not a functor"
     | `Class_replaced -> Format.fprintf fmt "Class replaced"
     | `Parent p -> pp_parent fmt p
+    | `UnexpandedTypeOf t ->
+        Format.fprintf fmt "Unexpanded `module type of` expression: %a"
+          Component.Fmt.module_type_type_of_desc t
+
 
   and pp_parent : Format.formatter -> parent_lookup_error -> unit =
    fun fmt err ->

src/xref2/expand_tools.ml

@@ -124,7 +124,7 @@ and aux_expansion_of_u_module_type_expr env expr :
     let subs = unresolve_subs subs in
     Tools.handle_signature_with_subs ~mark_substituted:false env sg subs)
   | TypeOf { t_expansion = Some (Signature sg); _} -> Ok sg
-  | TypeOf _ -> raise Tools.UnexpandedTypeOf
+  | TypeOf { t_desc; _ } -> Error (`UnexpandedTypeOf t_desc)
 
 and aux_expansion_of_module_type_expr env expr :
     (expansion, signature_of_module_error) Result.result =
@@ -142,7 +142,7 @@ and aux_expansion_of_module_type_expr env expr :
       >>= fun sg -> Ok (Signature sg)
   | Functor (arg, expr) -> Ok (Functor (arg, expr))
   | TypeOf {t_expansion = Some (Signature sg); _} -> Ok (Signature sg)
-  | TypeOf _ -> raise Tools.UnexpandedTypeOf
+  | TypeOf {t_desc; _} -> Error (`UnexpandedTypeOf t_desc)
 
 and aux_expansion_of_module_type env mt =
   let open Component.ModuleType in

src/xref2/tools.ml

@@ -4,7 +4,6 @@ open Odoc_model.Names
 open Utils
 open ResultMonad
 
-exception UnexpandedTypeOf
 type ('a, 'b) either = Left of 'a | Right of 'b
 
 type module_modifiers =
@@ -1014,7 +1013,7 @@ and signature_of_u_module_type_expr :
       signature_of_u_module_type_expr ~mark_substituted env s >>= fun sg ->
       handle_signature_with_subs ~mark_substituted env sg subs
   | TypeOf { t_expansion = Some (Signature sg); _ } -> Ok sg
-  | TypeOf _ -> raise UnexpandedTypeOf
+  | TypeOf { t_desc; _ } -> Error (`UnexpandedTypeOf t_desc )
 
 and signature_of_simple_expansion : Component.ModuleType.simple_expansion -> Component.Signature.t =
     function
@@ -1047,7 +1046,8 @@ and signature_of_module_type_expr :
       signature_of_module_type_expr ~mark_substituted env expr
   | Component.ModuleType.TypeOf { t_expansion = Some e; _ } ->
     Ok (signature_of_simple_expansion e)
-  | Component.ModuleType.TypeOf _ -> raise UnexpandedTypeOf
+  | Component.ModuleType.TypeOf { t_desc; _ } ->
+    Error (`UnexpandedTypeOf t_desc)
 
 and signature_of_module_type :
     Env.t ->
@@ -1463,6 +1463,7 @@ and resolve_module_fragment :
         | Ok (_m : Component.Signature.t) -> f'
         | Error `OpaqueModule -> `OpaqueModule f'
         | Error (`UnresolvedForwardPath | `UnresolvedPath _) -> f'
+        | Error (`UnexpandedTypeOf _ ) -> f'
       in
       Some (fixup_module_cfrag f'')
 
@@ -1548,14 +1549,16 @@ let resolve_module_path env p =
       match signature_of_module_cached env p m with
       | Ok _ -> Ok p
       | Error `OpaqueModule -> Ok (`OpaqueModule p)
-      | Error (`UnresolvedForwardPath | `UnresolvedPath _) -> Ok p )
+      | Error (`UnresolvedForwardPath | `UnresolvedPath _) -> Ok p
+      | Error (`UnexpandedTypeOf _) -> Ok p)
 
 let resolve_module_type_path env p =
   resolve_module_type ~mark_substituted:true env p >>= fun (p, mt) ->
   match signature_of_module_type env mt with
   | Ok _ -> Ok p
   | Error `OpaqueModule -> Ok (`OpaqueModuleType p)
-  | Error (`UnresolvedForwardPath | `UnresolvedPath _) -> Ok p
+  | Error (`UnresolvedForwardPath | `UnresolvedPath _)
+  | Error (`UnexpandedTypeOf _) -> Ok p
 
 let resolve_type_path env p = resolve_type env p >>= fun (p, _) -> Ok p
 

src/xref2/tools.mli

@@ -7,8 +7,6 @@
 
 open Errors.Tools_error
 
-exception UnexpandedTypeOf
-
 (** {2 Lookup and resolve functions} *)
 
 (** The following lookup and resolve functions take {{!module:Cpath.Resolved}resolved paths}

src/xref2/type_of.ml

@@ -61,8 +61,8 @@ and module_type_expr env (id : Id.Signature.t) expr =
   | TypeOf t ->
     match module_type_expr_typeof env id t with
     | Ok e -> TypeOf {t with t_expansion = Some (Lang_of.(simple_expansion empty id e)) }
+    | Error (`UnexpandedTypeOf _) -> again := true; expr
     | Error _ -> expr
-    | exception _ -> again := true; expr
 
 and u_module_type_expr env id expr =
   match expr with
@@ -72,8 +72,8 @@ and u_module_type_expr env id expr =
   | TypeOf t ->
     match module_type_expr_typeof env id t with
     | Ok e -> TypeOf {t with t_expansion = Some (Lang_of.(simple_expansion empty id e)) }
+    | Error (`UnexpandedTypeOf _) -> again := true; expr
     | Error _ -> expr
-    | exception _ -> again := true; expr
 
 and functor_parameter env p =
   { p with expr = module_type_expr env (p.id :> Id.Signature.t) p.expr}

test/xref2/multi_file_module_type_of.t/run.t

@@ -0,0 +1,41 @@
+Module type of across multiple modules
+======================================
+
+The logic to keep looping when we have nested `module type of` expressions needs
+to know when to stop. If the unexpanded `module type of` expression is actually in
+a separate module, no matter how many times we try it'll never work. Thus there is
+some logic to check before it loops to see if the signature has changed at all.
+If not, it doesn't loop. Without this logic, the following test would loop forever
+
+Here are the test files:
+
+  $ cat test0.mli
+  type t
+
+  $ cat test1.mli
+  module S : module type of Test0
+
+  $ cat test2.mli
+  module T : module type of Test1.S
+
+  $ ocamlc -c -bin-annot test0.mli
+  $ ocamlc -c -bin-annot test1.mli
+  $ ocamlc -c -bin-annot test2.mli
+
+In this instance, module S will not be expanded because we are not providing an
+odoc file for `Test0` - so there will be a warning when we run `odoc compile`
+on test1.cmti:
+
+  $ odoc compile --package foo test1.cmti
+  File "test1.cmti":
+  Failed to compile expansion for module type expression module type of unresolvedroot(Test0) Unexpanded `module type of` expression: module type of unresolvedroot(Test0)
+
+Similarly, module `T` also can not be expanded, therefore we expect
+another warning when we run `odoc compile` on test2.cmti:
+
+  $ odoc compile --package foo test2.cmti -I .
+  File "test2.cmti":
+  Failed to compile expansion for module type expression module type of unresolvedroot(Test1).S Unexpanded `module type of` expression: module type of unresolvedroot(Test1).S
+
+Crucially though, we do expect this command to have terminated!
+

test/xref2/multi_file_module_type_of.t/test0.mli

@@ -0,0 +1 @@
+type t

test/xref2/multi_file_module_type_of.t/test1.mli

@@ -0,0 +1,2 @@
+module S : module type of Test0
+

test/xref2/multi_file_module_type_of.t/test2.mli

@@ -0,0 +1,2 @@
+module T : module type of Test1.S
+

test/xref2/multi_module_type_of.t/run.t

@@ -0,0 +1,24 @@
+Multiple `module type of` statements
+====================================
+
+The way the `module type of` logic works is that an initial pass is made over the
+signature looking for `module type of` expressions and expanding them there and then.
+If there are 'nested' `module type of` expressions, that is, we're trying to find
+the type of a module that either is, or contains, a `module type of` expression 
+itself, then we loop.
+
+This is a test of this nested situation. Expanding module Z requires module Y
+to have been expanded.
+
+  $ cat test.mli
+  module X : sig type t end
+  module Y : module type of struct include X end
+  module Z : module type of Y
+
+
+If we correctly expand all of the `module type of` expressions there should be no
+warnings raised when we compile the module.
+
+  $ ocamlc -c -bin-annot test.mli
+  $ odoc compile --package test test.cmti
+

test/xref2/multi_module_type_of.t/test.mli

@@ -0,0 +1,4 @@
+module X : sig type t end
+module Y : module type of struct include X end
+module Z : module type of Y
+

test/xref2/unexpanded_module_type_of.t/run.t

@@ -0,0 +1,21 @@
+Unexpanded `module type of`
+===========================
+
+This is a test for [this issue](https://github.com/ocaml/odoc/issues/500)
+
+  $ cat test0.mli
+  type t
+
+  $ cat test.mli
+  module M: sig include module type of Test0 end
+
+  $ ocamlc -c -bin-annot test0.mli
+  $ ocamlc -c -bin-annot test.mli
+
+Compiling an odoc file for `test` without compiling one for `test0` 
+should _not_ result in an exception, merely a warning.
+
+  $ odoc compile --package test test.cmti
+  File "test.cmti":
+  Failed to compile expansion for include : module type of unresolvedroot(Test0) Unexpanded `module type of` expression: module type of unresolvedroot(Test0)
+

test/xref2/unexpanded_module_type_of.t/test.mli

@@ -0,0 +1,2 @@
+module M: sig include module type of Test0 end
+

test/xref2/unexpanded_module_type_of.t/test0.mli

@@ -0,0 +1 @@
+type t