From 6410a96b40d50c40c5c0e2d1e1a42e447bcd2fb5 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Thu, 25 Feb 2021 02:36:32 +0000 Subject: [PATCH 1/3] Add a test for #587 Signed-off-by: Jon Ludlam --- test/xref2/dune | 6 ++++ test/xref2/v408_and_above/dune | 2 ++ .../github_issue_587.t/a_intf.ml | 7 ++++ .../v408_and_above/github_issue_587.t/b.mli | 1 + .../github_issue_587.t/b_intf.ml | 13 ++++++++ .../github_issue_587.t/build.sh | 19 +++++++++++ .../v408_and_above/github_issue_587.t/c.mli | 1 + .../github_issue_587.t/odoc_bug__.ml | 3 ++ .../v408_and_above/github_issue_587.t/run.t | 32 +++++++++++++++++++ 9 files changed, 84 insertions(+) create mode 100644 test/xref2/v408_and_above/dune create mode 100644 test/xref2/v408_and_above/github_issue_587.t/a_intf.ml create mode 100644 test/xref2/v408_and_above/github_issue_587.t/b.mli create mode 100644 test/xref2/v408_and_above/github_issue_587.t/b_intf.ml create mode 100755 test/xref2/v408_and_above/github_issue_587.t/build.sh create mode 100644 test/xref2/v408_and_above/github_issue_587.t/c.mli create mode 100644 test/xref2/v408_and_above/github_issue_587.t/odoc_bug__.ml create mode 100644 test/xref2/v408_and_above/github_issue_587.t/run.t diff --git a/test/xref2/dune b/test/xref2/dune index 3169320f2f..6db5710a21 100644 --- a/test/xref2/dune +++ b/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)))) diff --git a/test/xref2/v408_and_above/dune b/test/xref2/v408_and_above/dune new file mode 100644 index 0000000000..a69446641a --- /dev/null +++ b/test/xref2/v408_and_above/dune @@ -0,0 +1,2 @@ +(cram + (deps %{bin:odoc} %{bin:odoc_print} %{bin:compile})) diff --git a/test/xref2/v408_and_above/github_issue_587.t/a_intf.ml b/test/xref2/v408_and_above/github_issue_587.t/a_intf.ml new file mode 100644 index 0000000000..1cefe76e84 --- /dev/null +++ b/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 diff --git a/test/xref2/v408_and_above/github_issue_587.t/b.mli b/test/xref2/v408_and_above/github_issue_587.t/b.mli new file mode 100644 index 0000000000..0a3e523a5b --- /dev/null +++ b/test/xref2/v408_and_above/github_issue_587.t/b.mli @@ -0,0 +1 @@ +include B_intf.B diff --git a/test/xref2/v408_and_above/github_issue_587.t/b_intf.ml b/test/xref2/v408_and_above/github_issue_587.t/b_intf.ml new file mode 100644 index 0000000000..ca9552eae4 --- /dev/null +++ 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 diff --git a/test/xref2/v408_and_above/github_issue_587.t/build.sh b/test/xref2/v408_and_above/github_issue_587.t/build.sh new file mode 100755 index 0000000000..37cc89caf9 --- /dev/null +++ b/test/xref2/v408_and_above/github_issue_587.t/build.sh @@ -0,0 +1,19 @@ +#!/bin/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 + diff --git a/test/xref2/v408_and_above/github_issue_587.t/c.mli b/test/xref2/v408_and_above/github_issue_587.t/c.mli new file mode 100644 index 0000000000..37d3d69847 --- /dev/null +++ b/test/xref2/v408_and_above/github_issue_587.t/c.mli @@ -0,0 +1 @@ +include B.S diff --git a/test/xref2/v408_and_above/github_issue_587.t/odoc_bug__.ml b/test/xref2/v408_and_above/github_issue_587.t/odoc_bug__.ml new file mode 100644 index 0000000000..aed21faf3a --- /dev/null +++ b/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 diff --git a/test/xref2/v408_and_above/github_issue_587.t/run.t b/test/xref2/v408_and_above/github_issue_587.t/run.t new file mode 100644 index 0000000000..723130317d --- /dev/null +++ b/test/xref2/v408_and_above/github_issue_587.t/run.t @@ -0,0 +1,32 @@ +A quick test to repro the issue found in #587 + + $ ./build.sh + odoc: internal error, uncaught exception: + Failure("Error") + Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33 + Called from Odoc_xref2__Subst.rename_bound_idents.new_module_id in file "src/xref2/subst.ml", line 771, characters 13-29 + Called from Odoc_xref2__Subst.rename_bound_idents.(fun) in file "src/xref2/subst.ml", line 809, characters 16-32 + Called from Odoc_xref2__Subst.rename_bound_idents.(fun) in file "src/xref2/subst.ml", line 868, characters 8-69 + Called from Odoc_xref2__Subst.signature in file "src/xref2/subst.ml", line 907, characters 17-50 + Called from Odoc_xref2__Subst.simple_expansion in file "src/xref2/subst.ml", line 503, characters 30-46 + Called from Odoc_xref2__Subst.option_ in file "src/xref2/subst.ml", line 412, characters 51-61 + Called from Odoc_xref2__Subst.module_type_expr in file "src/xref2/subst.ml", line 599, characters 24-62 + Called from Odoc_xref2__Subst.module_type in file "src/xref2/subst.ml", line 509, characters 37-59 + Called from Odoc_xref2__Tools.handle_module_type_lookup.(fun) in file "src/xref2/tools.ml", line 415, characters 13-37 + Called from Odoc_xref2__Tools.resolve_module_type.(fun) in file "src/xref2/tools.ml", line 708, characters 8-68 + Called from Odoc_xref2__Expand_tools.aux_expansion_of_u_module_type_expr in file "src/xref2/expand_tools.ml", line 111, characters 6-61 + Called from Odoc_xref2__Compile.include_.get_expansion in file "src/xref2/compile.ml", line 325, characters 10-66 + Called from Odoc_xref2__Compile.signature_items.(fun) in file "src/xref2/compile.ml", line 240, characters 21-35 + Called from Stdlib__list.fold_left in file "list.ml", line 121, characters 24-34 + Called from Odoc_xref2__Compile.signature_items in file "src/xref2/compile.ml", line 204, characters 4-1023 + Called from Odoc_xref2__Compile.signature in file "src/xref2/compile.ml", line 273, characters 16-46 + Called from Odoc_xref2__Compile.content.(fun) in file "src/xref2/compile.ml", line 66, characters 13-54 + Called from Odoc_xref2__Compile.unit in file "src/xref2/compile.ml", line 59, characters 21-47 + Called from Odoc_xref2__Lookup_failures.catch_failures in file "src/xref2/lookup_failures.ml", line 18, characters 10-14 + Called from Odoc_odoc__Compile.resolve_and_substitute.(fun) in file "src/odoc/compile.ml", line 74, characters 2-37 + Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 25, characters 19-24 + Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 23, characters 12-19 + Called from Cmdliner.Term.run in file "cmdliner.ml", line 117, characters 32-39 + [2] + + From 50926f2bb7e7d50f3a91e48838189041a80b8566 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Thu, 25 Feb 2021 01:50:51 +0000 Subject: [PATCH 2/3] Shadowing simplification This still isn't quite right, but it's definitely less wrong with this fix. Signed-off-by: Jon Ludlam --- src/loader/cmi.ml | 12 +++---- src/model/lang.ml | 12 +++---- src/model_desc/lang_desc.ml | 18 ++++------ src/xref2/lang_of.ml | 35 +++++++++++-------- .../v408_and_above/github_issue_587.t/run.t | 27 -------------- 5 files changed, 39 insertions(+), 65 deletions(-) diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml index 4040085882..a78d412c67 100644 --- a/src/loader/cmi.ml +++ b/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,7 +937,7 @@ 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 @@ -945,7 +945,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) = 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,7 +954,7 @@ 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 @@ -962,7 +962,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) = 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 diff --git a/src/model/lang.ml b/src/model/lang.ml index 18d84ef408..abc8189d93 100644 --- a/src/model/lang.ml +++ b/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 } diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index 0cfc79652e..fed3f3c59c 100644 --- a/src/model_desc/lang_desc.ml +++ b/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 = diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml index 8ed88f5d7e..a9dcfadc85 100644 --- a/src/xref2/lang_of.ml +++ b/src/xref2/lang_of.ml @@ -247,8 +247,11 @@ 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 (Ident.Name.type_ id) + ) else `Type (parent, Ident.Name.typed_type id) in { @@ -262,20 +265,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 +288,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 +310,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 +524,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; diff --git a/test/xref2/v408_and_above/github_issue_587.t/run.t b/test/xref2/v408_and_above/github_issue_587.t/run.t index 723130317d..9b720edd7d 100644 --- a/test/xref2/v408_and_above/github_issue_587.t/run.t +++ b/test/xref2/v408_and_above/github_issue_587.t/run.t @@ -1,32 +1,5 @@ A quick test to repro the issue found in #587 $ ./build.sh - odoc: internal error, uncaught exception: - Failure("Error") - Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33 - Called from Odoc_xref2__Subst.rename_bound_idents.new_module_id in file "src/xref2/subst.ml", line 771, characters 13-29 - Called from Odoc_xref2__Subst.rename_bound_idents.(fun) in file "src/xref2/subst.ml", line 809, characters 16-32 - Called from Odoc_xref2__Subst.rename_bound_idents.(fun) in file "src/xref2/subst.ml", line 868, characters 8-69 - Called from Odoc_xref2__Subst.signature in file "src/xref2/subst.ml", line 907, characters 17-50 - Called from Odoc_xref2__Subst.simple_expansion in file "src/xref2/subst.ml", line 503, characters 30-46 - Called from Odoc_xref2__Subst.option_ in file "src/xref2/subst.ml", line 412, characters 51-61 - Called from Odoc_xref2__Subst.module_type_expr in file "src/xref2/subst.ml", line 599, characters 24-62 - Called from Odoc_xref2__Subst.module_type in file "src/xref2/subst.ml", line 509, characters 37-59 - Called from Odoc_xref2__Tools.handle_module_type_lookup.(fun) in file "src/xref2/tools.ml", line 415, characters 13-37 - Called from Odoc_xref2__Tools.resolve_module_type.(fun) in file "src/xref2/tools.ml", line 708, characters 8-68 - Called from Odoc_xref2__Expand_tools.aux_expansion_of_u_module_type_expr in file "src/xref2/expand_tools.ml", line 111, characters 6-61 - Called from Odoc_xref2__Compile.include_.get_expansion in file "src/xref2/compile.ml", line 325, characters 10-66 - Called from Odoc_xref2__Compile.signature_items.(fun) in file "src/xref2/compile.ml", line 240, characters 21-35 - Called from Stdlib__list.fold_left in file "list.ml", line 121, characters 24-34 - Called from Odoc_xref2__Compile.signature_items in file "src/xref2/compile.ml", line 204, characters 4-1023 - Called from Odoc_xref2__Compile.signature in file "src/xref2/compile.ml", line 273, characters 16-46 - Called from Odoc_xref2__Compile.content.(fun) in file "src/xref2/compile.ml", line 66, characters 13-54 - Called from Odoc_xref2__Compile.unit in file "src/xref2/compile.ml", line 59, characters 21-47 - Called from Odoc_xref2__Lookup_failures.catch_failures in file "src/xref2/lookup_failures.ml", line 18, characters 10-14 - Called from Odoc_odoc__Compile.resolve_and_substitute.(fun) in file "src/odoc/compile.ml", line 74, characters 2-37 - Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 25, characters 19-24 - Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 23, characters 12-19 - Called from Cmdliner.Term.run in file "cmdliner.ml", line 117, characters 32-39 - [2] From 503148f7f0aeca89ac66090553d0656f17ae293a Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Fri, 26 Feb 2021 17:38:00 +0000 Subject: [PATCH 3/3] PR review suggestions --- src/xref2/lang_of.ml | 5 +---- test/xref2/v408_and_above/github_issue_587.t/build.sh | 2 +- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml index a9dcfadc85..f2c9ce22df 100644 --- a/src/xref2/lang_of.ml +++ b/src/xref2/lang_of.ml @@ -248,10 +248,7 @@ module ExtractIDs = struct let name = Ident.Name.type_ id in let identifier = if List.mem name map.shadowed.s_types then - `Type - ( parent, - Odoc_model.Names.TypeName.internal_of_string (Ident.Name.type_ id) - ) + `Type (parent, Odoc_model.Names.TypeName.internal_of_string name) else `Type (parent, Ident.Name.typed_type id) in { diff --git a/test/xref2/v408_and_above/github_issue_587.t/build.sh b/test/xref2/v408_and_above/github_issue_587.t/build.sh index 37cc89caf9..66342acd59 100755 --- a/test/xref2/v408_and_above/github_issue_587.t/build.sh +++ b/test/xref2/v408_and_above/github_issue_587.t/build.sh @@ -1,4 +1,4 @@ -#!/bin/sh +#!/usr/bin/env sh OCAMLC=ocamlc ODOC=odoc