diff --git a/src/model_desc/comment_desc.ml b/src/model_desc/comment_desc.ml index eb90fd8a1a..103579bb5b 100644 --- a/src/model_desc/comment_desc.ml +++ b/src/model_desc/comment_desc.ml @@ -3,13 +3,7 @@ open Odoc_model open Comment open Paths_desc -let location = - let open Location_ in - let point () p = Printf.sprintf "%d:%d" p.line p.column in - To_string - (fun s -> Printf.sprintf "%s %a %a" s.file point s.start point s.end_) - -let loc_to_pair x = (x.Location_.location, x.value) +let ignore_loc x = x.Location_.value type general_inline_element = [ `Space @@ -71,7 +65,7 @@ let rec inline_element : general_inline_element t = | `Link (x1, x2) -> C ("`Link", (x1, x2), Pair (string, link_content))) and link_content : general_link_content t = - List (Indirect (loc_to_pair, Pair (location, inline_element))) + List (Indirect (ignore_loc, inline_element)) let rec block_element : general_block_element t = let heading_level = @@ -126,8 +120,7 @@ and tag : general_tag t = | `Open -> C0 "`Open" | `Closed -> C0 "`Closed") -and docs : general_docs t = - List (Indirect (loc_to_pair, Pair (location, block_element))) +and docs : general_docs t = List (Indirect (ignore_loc, block_element)) let docs = Indirect ((fun n -> ((n :> docs) :> general_docs)), docs) diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 5b37dfec80..160dbc3575 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -721,10 +721,6 @@ let rec open_signature : Odoc_model.Lang.Signature.t -> t -> t = | Odoc_model.Lang.Signature.Open o -> open_signature o.expansion env) e s.items -let open_unit : Odoc_model.Lang.Compilation_unit.t -> t -> t = - fun unit env -> - match unit.content with Module s -> open_signature s env | Pack _ -> env - let initial_env : Odoc_model.Lang.Compilation_unit.t -> resolver -> diff --git a/src/xref2/env.mli b/src/xref2/env.mli index e97c9a30cb..e7ba33812f 100644 --- a/src/xref2/env.mli +++ b/src/xref2/env.mli @@ -189,8 +189,6 @@ val open_class_signature : Odoc_model.Lang.ClassSignature.t -> t -> t val open_signature : Odoc_model.Lang.Signature.t -> t -> t -val open_unit : Odoc_model.Lang.Compilation_unit.t -> t -> t - val initial_env : Odoc_model.Lang.Compilation_unit.t -> resolver -> diff --git a/src/xref2/link.ml b/src/xref2/link.ml index c378584d49..5637595775 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -107,18 +107,18 @@ and module_path : Env.t -> Paths.Path.Module.t -> Paths.Path.Module.t = let rec unit (resolver : Env.resolver) t = let open Compilation_unit in let imports, env = Env.initial_env t resolver in - { - t with - content = content env t.id t.content; - doc = comment_docs env t.doc; - imports; - } - -and content env id = - let open Compilation_unit in - function - | Module m -> Module (signature env (id :> Id.Signature.t) m) - | Pack p -> Pack p + let env = (* Add doc to env *) Env.add_docs t.doc env in + let content, env = + match t.content with + | Module sg -> + (* Inline [signature] to keep [env]. *) + let env = Env.open_signature sg env in + let items = signature_items env (t.id :> Id.Signature.t) sg.items in + (Module { sg with items }, env) + | Pack _ as p -> (p, env) + in + let doc = comment_docs env t.doc in + { t with content; doc; imports } and value_ env parent t = let open Value in diff --git a/test/pages/resolution.t/run.t b/test/pages/resolution.t/run.t index 739fdda91c..b4a2aabf79 100644 --- a/test/pages/resolution.t/run.t +++ b/test/pages/resolution.t/run.t @@ -27,7 +27,7 @@ If everything has worked to plan, we'll have resolved references for all of the references should be to the correct identifiers - so top1 should be a RootPage, sub1 is a Page, sub2 is a LeafPage, and m1 is a Root. This is the '{!childpage-sub1}' reference - $ odoc_print page-top1.odocl | jq '.content[1][1]["`Paragraph"][0][1]["`Reference"][0]' + $ odoc_print page-top1.odocl | jq '.content[1]["`Paragraph"][0]["`Reference"][0]' { "`Resolved": { "`Identifier": { @@ -42,7 +42,7 @@ This is the '{!childpage-sub1}' reference } This is the '{!childpage:sub2}' reference - $ odoc_print page-top1.odocl | jq '.content[1][1]["`Paragraph"][2][1]["`Reference"][0]' + $ odoc_print page-top1.odocl | jq '.content[1]["`Paragraph"][2]["`Reference"][0]' { "`Resolved": { "`Identifier": { @@ -57,7 +57,7 @@ This is the '{!childpage:sub2}' reference } This is the '{!childmodule:M1}' reference - $ odoc_print page-sub1.odocl | jq '.content[1][1]["`Paragraph"][0][1]["`Reference"][0]' + $ odoc_print page-sub1.odocl | jq '.content[1]["`Paragraph"][0]["`Reference"][0]' { "`Resolved": { "`Identifier": { diff --git a/test/xref2/cross_references.t/run.t b/test/xref2/cross_references.t/run.t index de32e26de6..98db613cd1 100644 --- a/test/xref2/cross_references.t/run.t +++ b/test/xref2/cross_references.t/run.t @@ -11,53 +11,47 @@ Two modules that reference each other: Check that references are resolved: - $ odoc_print a.odocl | jq '.content.Module.items[0].Type[1].doc[0][1]' + $ odoc_print a.odocl | jq '.content.Module.items[0].Type[1].doc[0]' { "`Paragraph": [ - [ - "a.mli 2:4 2:8", - { - "`Reference": [ - { - "`Resolved": { - "`Identifier": { - "`Root": [ - { - "`RootPage": "test" - }, - "B" - ] - } + { + "`Reference": [ + { + "`Resolved": { + "`Identifier": { + "`Root": [ + { + "`RootPage": "test" + }, + "B" + ] } - }, - [] - ] - } - ] + } + }, + [] + ] + } ] } - $ odoc_print b.odocl | jq '.content.Module.items[0].Type[1].doc[0][1]' + $ odoc_print b.odocl | jq '.content.Module.items[0].Type[1].doc[0]' { "`Paragraph": [ - [ - "b.mli 2:4 2:8", - { - "`Reference": [ - { - "`Resolved": { - "`Identifier": { - "`Root": [ - { - "`RootPage": "test" - }, - "A" - ] - } + { + "`Reference": [ + { + "`Resolved": { + "`Identifier": { + "`Root": [ + { + "`RootPage": "test" + }, + "A" + ] } - }, - [] - ] - } - ] + } + }, + [] + ] + } ] } diff --git a/test/xref2/references_scope.t/a.mli b/test/xref2/references_scope.t/a.mli new file mode 100644 index 0000000000..08e4d34ede --- /dev/null +++ b/test/xref2/references_scope.t/a.mli @@ -0,0 +1,19 @@ +(** Text attached to references are written as single words to have a more + readable output. + References from the first comment (which is the doc of the entire module): + {{!B.C}Doc-relative} + {{!A.B.C}Doc-absolute} *) + +(** References from inside the module's signature: + {{!B.C}Defined-below} + {{!A.B.C}Defined-below-but-absolute} *) + +module B : sig + module C : sig end +end + +module D : sig + open B + + (** {{!C}Through-open} *) +end diff --git a/test/xref2/references_scope.t/run.t b/test/xref2/references_scope.t/run.t new file mode 100644 index 0000000000..4799ee8ac6 --- /dev/null +++ b/test/xref2/references_scope.t/run.t @@ -0,0 +1,14 @@ +# Testing the scope of references + + $ compile a.mli + + $ jq_scan_references() { jq -c '.. | .["`Reference"]? | select(.)'; } + +The references from a.mli, see the attached text to recognize them: + + $ odoc_print a.odocl | jq_scan_references + [{"`Resolved":{"`Module":[{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"A"]},"B"]}},"C"]}},[{"`Word":"Doc-relative"}]] + [{"`Resolved":{"`Module":[{"`Module":[{"`Identifier":{"`Root":[{"`RootPage":"test"},"A"]}},"B"]},"C"]}},[{"`Word":"Doc-absolute"}]] + [{"`Resolved":{"`Module":[{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"A"]},"B"]}},"C"]}},[{"`Word":"Defined-below"}]] + [{"`Resolved":{"`Module":[{"`Module":[{"`Identifier":{"`Root":[{"`RootPage":"test"},"A"]}},"B"]},"C"]}},[{"`Word":"Defined-below-but-absolute"}]] + [{"`Root":["C","`TUnknown"]},[{"`Word":"Through-open"}]]