Fix #587

src/loader/cmi.ml

@@ -901,7 +901,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
         let vd = read_value_description env parent id v in
         let shadowed =
           if Env.is_shadowed env id
-          then { shadowed with s_values = (Ident.name id, (Env.find_value_identifier env id)) :: shadowed.s_values }
+          then { shadowed with s_values = Ident.name id :: shadowed.s_values }
           else shadowed
         in
           loop (vd :: acc, shadowed) rest
@@ -912,7 +912,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
         let decl = read_type_declaration env parent id decl in
         let shadowed =
           if Env.is_shadowed env id
-          then { shadowed with s_types = (Ident.name id, decl.id) :: shadowed.s_types }
+          then { shadowed with s_types = Ident.name id :: shadowed.s_types }
           else shadowed
         in
         loop (Type (read_type_rec_status rec_status, decl)::acc, shadowed) rest
@@ -937,15 +937,15 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
           let md = read_module_declaration env parent id md in
           let shadowed =
             if Env.is_shadowed env id
-            then { shadowed with s_modules = (Ident.name id, md.id) :: shadowed.s_modules }
+            then { shadowed with s_modules = Ident.name id :: shadowed.s_modules }
             else shadowed
           in
             loop (Module (read_module_rec_status rec_status, md)::acc, shadowed) rest
     | Sig_modtype(id, mtd, _) :: rest ->
           let mtd = read_module_type_declaration env parent id mtd in
           let shadowed =
             if Env.is_shadowed env id
-            then { shadowed with s_module_types = (Ident.name id, mtd.id) :: shadowed.s_module_types }
+            then { shadowed with s_module_types = Ident.name id :: shadowed.s_module_types }
             else shadowed
           in
             loop (ModuleType mtd :: acc, shadowed) rest
@@ -954,15 +954,15 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
           let cl = read_class_declaration env parent id cl in
           let shadowed =
             if Env.is_shadowed env id
-            then { shadowed with s_classes = (Ident.name id, cl.id) :: shadowed.s_classes }
+            then { shadowed with s_classes = Ident.name id :: shadowed.s_classes }
             else shadowed
           in
             loop (Class (read_type_rec_status rec_status, cl)::acc, shadowed) rest
     | Sig_class_type(id, cltyp, rec_status, _)::Sig_type _::Sig_type _::rest ->
         let cltyp = read_class_type_declaration env parent id cltyp in
         let shadowed =
           if Env.is_shadowed env id
-          then { shadowed with s_class_types = (Ident.name id, cltyp.id) :: shadowed.s_class_types }
+          then { shadowed with s_class_types = Ident.name id :: shadowed.s_class_types }
           else shadowed
         in
         loop (ClassType (read_type_rec_status rec_status, cltyp)::acc, shadowed) rest

src/model/lang.ml

@@ -148,12 +148,12 @@ end =
 
 and Include : sig
   type shadowed = {
-    s_modules : (string * Identifier.Module.t) list;
-    s_module_types : (string * Identifier.ModuleType.t) list;
-    s_values : (string * Identifier.Value.t) list;
-    s_types : (string * Identifier.Type.t) list;
-    s_classes : (string * Identifier.Class.t) list;
-    s_class_types : (string * Identifier.ClassType.t) list;
+    s_modules : string list;
+    s_module_types : string list;
+    s_values : string list;
+    s_types : string list;
+    s_classes : string list;
+    s_class_types : string list;
   }
 
   type expansion = { shadowed : shadowed; content : Signature.t }

src/model_desc/lang_desc.ml

@@ -216,18 +216,12 @@ and include_shadowed =
   let open Lang.Include in
   Record
     [
-      F ("s_modules", (fun t -> t.s_modules), List (Pair (string, identifier)));
-      F
-        ( "s_module_types",
-          (fun t -> t.s_module_types),
-          List (Pair (string, identifier)) );
-      F ("s_values", (fun t -> t.s_values), List (Pair (string, identifier)));
-      F ("s_types", (fun t -> t.s_types), List (Pair (string, identifier)));
-      F ("s_classes", (fun t -> t.s_classes), List (Pair (string, identifier)));
-      F
-        ( "s_class_types",
-          (fun t -> t.s_class_types),
-          List (Pair (string, identifier)) );
+      F ("s_modules", (fun t -> t.s_modules), List string);
+      F ("s_module_types", (fun t -> t.s_module_types), List string);
+      F ("s_values", (fun t -> t.s_values), List string);
+      F ("s_types", (fun t -> t.s_types), List string);
+      F ("s_classes", (fun t -> t.s_classes), List string);
+      F ("s_class_types", (fun t -> t.s_class_types), List string);
     ]
 
 and include_expansion =

src/xref2/lang_of.ml

@@ -247,8 +247,8 @@ module ExtractIDs = struct
   let rec type_decl parent map id =
     let name = Ident.Name.type_ id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_types then
-        List.assoc name map.shadowed.s_types
+      if List.mem name map.shadowed.s_types then
+        `Type (parent, Odoc_model.Names.TypeName.internal_of_string name)
       else `Type (parent, Ident.Name.typed_type id)
     in
     {
@@ -262,20 +262,19 @@ module ExtractIDs = struct
     }
 
   and module_ parent map id =
-    let name' = Ident.Name.typed_module id in
-    let name = ModuleName.to_string name' in
+    let name = Ident.Name.module_ id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_modules then
-        List.assoc name map.shadowed.s_modules
-      else `Module (parent, name')
+      if List.mem name map.shadowed.s_modules then
+        `Module (parent, ModuleName.internal_of_string name)
+      else `Module (parent, Ident.Name.typed_module id)
     in
     { map with module_ = Component.ModuleMap.add id identifier map.module_ }
 
   and module_type parent map id =
     let name = Ident.Name.module_type id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_module_types then
-        List.assoc name map.shadowed.s_module_types
+      if List.mem name map.shadowed.s_module_types then
+        `ModuleType (parent, ModuleTypeName.internal_of_string name)
       else `ModuleType (parent, Ident.Name.typed_module_type id)
     in
     {
@@ -286,8 +285,8 @@ module ExtractIDs = struct
   and class_ parent map id =
     let name = Ident.Name.class_ id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_classes then
-        List.assoc name map.shadowed.s_classes
+      if List.mem name map.shadowed.s_classes then
+        `Class (parent, ClassName.internal_of_string name)
       else `Class (parent, Ident.Name.typed_class id)
     in
     {
@@ -308,8 +307,8 @@ module ExtractIDs = struct
   and class_type parent map (id : Ident.class_type) =
     let name = Ident.Name.class_type id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_class_types then
-        List.assoc name map.shadowed.s_class_types
+      if List.mem name map.shadowed.s_class_types then
+        `ClassType (parent, ClassTypeName.internal_of_string name)
       else `ClassType (parent, Ident.Name.typed_class_type id)
     in
     {
@@ -522,7 +521,12 @@ and instance_variable map parent id i =
 
 and external_ map parent id e =
   let open Component.External in
-  let identifier = `Value (parent, Ident.Name.typed_value id) in
+  let name = Ident.Name.value id in
+  let identifier =
+    if List.mem name map.shadowed.s_values then
+      `Value (parent, ValueName.internal_of_string name)
+    else `Value (parent, Ident.Name.typed_value id)
+  in
   {
     id = identifier;
     doc = docs (parent :> Identifier.LabelParent.t) e.doc;

test/xref2/dune

@@ -13,3 +13,9 @@
 
 (cram
  (deps %{bin:odoc} %{bin:odoc_print} %{bin:compile}))
+
+(subdir
+ v408_and_above
+ (cram
+  (enabled_if
+   (>= %{ocaml_version} 4.08.0))))

test/xref2/v408_and_above/dune

@@ -0,0 +1,2 @@
+(cram
+ (deps %{bin:odoc} %{bin:odoc_print} %{bin:compile}))

test/xref2/v408_and_above/github_issue_587.t/a_intf.ml

@@ -0,0 +1,7 @@
+module type S = sig
+  module Foo : sig end
+end
+
+module type A = sig
+  module type S = S
+end

test/xref2/v408_and_above/github_issue_587.t/b.mli

@@ -0,0 +1 @@
+include B_intf.B

test/xref2/v408_and_above/github_issue_587.t/b_intf.ml

@@ -0,0 +1,13 @@
+module Bar = struct end
+
+module type S = sig
+  include A_intf.S
+
+  module Foo : sig end
+end
+
+module type B = sig
+  module type S = S
+
+  include S
+end

test/xref2/v408_and_above/github_issue_587.t/build.sh

@@ -0,0 +1,19 @@
+#!/usr/bin/env sh
+
+OCAMLC=ocamlc
+ODOC=odoc
+
+$OCAMLC -w -49 -no-alias-deps -c odoc_bug__.ml -bin-annot
+
+for f in a_intf b_intf; do
+  $OCAMLC -c $f.ml -bin-annot -g -no-alias-deps -open Odoc_bug__ -o odoc_bug__$f
+done
+
+for f in b c; do
+  $OCAMLC -c -intf $f.mli -bin-annot -no-alias-deps -open Odoc_bug__ -o odoc_bug__$f
+done
+
+for f in .cmt a_intf.cmt b_intf.cmt b.cmti c.cmti; do
+  odoc compile odoc_bug__$f -I . --pkg odoc_bug
+done
+

test/xref2/v408_and_above/github_issue_587.t/c.mli

@@ -0,0 +1 @@
+include B.S

test/xref2/v408_and_above/github_issue_587.t/odoc_bug__.ml

@@ -0,0 +1,3 @@
+module A_intf = Odoc_bug__a_intf
+module B = Odoc_bug__b
+module B_intf = Odoc_bug__b_intf

test/xref2/v408_and_above/github_issue_587.t/run.t

@@ -0,0 +1,5 @@
+A quick test to repro the issue found in #587
+
+  $ ./build.sh
+
+