diff --git a/CHANGES.md b/CHANGES.md index 6cb5bf928b..93aafd9616 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -12,6 +12,8 @@ - Remove requirement for ppx_expect in tests (@jonludlam, #1445) - Fix resolving functor through `module type of` (@Leonidas-from-XIV, #1471) - Fix odoc_driver's detection of `stdlib` when it is in `$prefix/lib64`, requires ocamlfind >= 1.9.8 (@katrinafyi, #1477, #1474) +- Don't let an unrelated `@canonical` tag halt the search for a self-canonical + module, which lost the expansion of the module it named (@jonludlam, #1483) # 3.2.1 diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml index 8f3964c584..7169552e75 100644 --- a/src/xref2/tools.ml +++ b/src/xref2/tools.ml @@ -1344,13 +1344,14 @@ and handle_canonical_module_real env p2 = If not, check for an alias chain with us as canonical in it... *) let rec check m = match m.Component.Module.canonical with - | Some p -> - p = p2 - (* The canonical path is the same one we're trying to resolve *) - | None -> ( + | Some p when p = p2 -> true + | _ -> ( + (* An unrelated canonical tag - Dune tags every alias with + [Lib.M], even ones [lib.ml] doesn't re-export - mustn't + stop the search: a module further down the chain may + still be the one we're looking for. *) match m.type_ with | Component.Module.Alias (p, _) -> ( - (* Format.eprintf "Going to resolve %a\n%!" Component.Fmt.module_path p; *) match resolve_module env p with | Ok (rp, _) -> ( match lookup_module env rp with diff --git a/test/xref2/canonical_missing_alias.t/main.ml b/test/xref2/canonical_missing_alias.t/main.ml new file mode 100644 index 0000000000..e9085f4731 --- /dev/null +++ b/test/xref2/canonical_missing_alias.t/main.ml @@ -0,0 +1,11 @@ +open Main__ + +module Foo = Foo + +(* [Zone] is exposed here, but under a different name - so [Main.Zone], the + canonical path Dune put on the alias in [main__.ml], does not exist. *) +module Private = struct + module Zone_alias = Zone +end + +let zone_name = Zone.name diff --git a/test/xref2/canonical_missing_alias.t/main__.ml b/test/xref2/canonical_missing_alias.t/main__.ml new file mode 100644 index 0000000000..6489b3a069 --- /dev/null +++ b/test/xref2/canonical_missing_alias.t/main__.ml @@ -0,0 +1,5 @@ +(** @canonical Main.Zone *) +module Zone = Main__Zone + +(** @canonical Main.Foo *) +module Foo = Main__Foo diff --git a/test/xref2/canonical_missing_alias.t/main__Foo.mli b/test/xref2/canonical_missing_alias.t/main__Foo.mli new file mode 100644 index 0000000000..22eb16465e --- /dev/null +++ b/test/xref2/canonical_missing_alias.t/main__Foo.mli @@ -0,0 +1 @@ +val f : Zone.t -> int diff --git a/test/xref2/canonical_missing_alias.t/main__Zone.mli b/test/xref2/canonical_missing_alias.t/main__Zone.mli new file mode 100644 index 0000000000..3867362d8b --- /dev/null +++ b/test/xref2/canonical_missing_alias.t/main__Zone.mli @@ -0,0 +1,3 @@ +type t + +val name : t -> string diff --git a/test/xref2/canonical_missing_alias.t/run.t b/test/xref2/canonical_missing_alias.t/run.t new file mode 100644 index 0000000000..c1c00b709d --- /dev/null +++ b/test/xref2/canonical_missing_alias.t/run.t @@ -0,0 +1,135 @@ +This test reproduces a problem seen in real libraries (Jane Street's `core` +being the motivating example) that use Dune's wrapping together with a +hand-written top-level module. + +Dune generates the alias module `main__.ml` with a canonical tag `Main.M` for +every module `M` in the library. When `main.ml` is hand-written, it is up to +the author to re-export those modules under exactly those names. If a module +is re-exported under a *different* name - or not at all - the canonical path +Dune wrote down doesn't exist, and references to that module can't be +resolved. See `doc/dune.mld` for a description of the wrapping scheme. + +Here `Zone` is a module of the library: + + $ cat main__Zone.mli + type t + + val name : t -> string + + +`main__Foo.mli` refers to it, so `Zone.t` will end up in `Main.Foo`'s +signature: + + $ cat main__Foo.mli + val f : Zone.t -> int + +This is the alias module Dune generates. Note the canonical tag on `Zone` +pointing at `Main.Zone`: + + $ cat main__.ml + (** @canonical Main.Zone *) + module Zone = Main__Zone + + (** @canonical Main.Foo *) + module Foo = Main__Foo + + +But the hand-written `main.ml` doesn't have a `Zone` alias - it exposes the +module under a different name, so `Main.Zone` never exists: + + $ cat main.ml + open Main__ + + module Foo = Foo + + (* [Zone] is exposed here, but under a different name - so [Main.Zone], the + canonical path Dune put on the alias in [main__.ml], does not exist. *) + module Private = struct + module Zone_alias = Zone + end + + let zone_name = Zone.name + + + + +Build it the way Dune does: the alias module first, with `-no-alias-deps`, and +everything else with `-open Main__`. + + $ ocamlc -c -bin-annot -no-alias-deps -w -49 main__.ml + $ ocamlc -c -bin-annot -no-alias-deps main__Zone.mli + $ ocamlc -c -bin-annot -no-alias-deps -open Main__ main__Foo.mli + $ ocamlc -c -bin-annot -no-alias-deps -open Main__ main.ml + + $ odoc compile -I . main__Zone.cmti + $ odoc compile -I . main__.cmt + $ odoc compile -I . main__Foo.cmti + $ odoc compile -I . main.cmt + $ odoc link -I . main.odoc + $ odoc html-generate --indent -o html main.odocl + +`Main.Private.Zone_alias` is documented, since it's an alias of a hidden +module and so gets expanded: + + $ find html/Main -name index.html | sort + html/Main/Foo/index.html + html/Main/Private/Zone_alias/index.html + html/Main/Private/index.html + html/Main/index.html + +But the reference in `Main.Foo` is unresolved: the canonical path `Main.Zone` +can't be resolved, and odoc has no way of knowing that +`Main.Private.Zone_alias` names the same module. + + $ grep -A3 'val f' html/Main/Foo/index.html + val f : + Main__.Zone.t + -> + int + +The fix is to give `Zone` a canonical path that actually exists. The tag Dune +generates can't be changed, but a canonical tag in the module's own preamble +takes precedence over it, so the library author can correct it from +`main__Zone.mli`: + + $ printf '(** @canonical Main.Private.Zone_alias *)\n\n' | cat - main__Zone.mli > t && mv t main__Zone.mli + $ cat main__Zone.mli + (** @canonical Main.Private.Zone_alias *) + + type t + + val name : t -> string + + + + $ rm -rf html *.cm* *.odoc *.odocl + $ ocamlc -c -bin-annot -no-alias-deps -w -49 main__.ml + $ ocamlc -c -bin-annot -no-alias-deps main__Zone.mli + $ ocamlc -c -bin-annot -no-alias-deps -open Main__ main__Foo.mli + $ ocamlc -c -bin-annot -no-alias-deps -open Main__ main.ml + + $ odoc compile -I . main__Zone.cmti + $ odoc compile -I . main__.cmt + $ odoc compile -I . main__Foo.cmti + $ odoc compile -I . main.cmt + $ odoc link -I . main.odoc + $ odoc html-generate --indent -o html main.odocl + +`Main.Private.Zone_alias` is still documented - it must not lose its expansion +just because it is now the canonical destination of the module it is an alias +of: + + $ find html/Main -name index.html | sort + html/Main/Foo/index.html + html/Main/Private/Zone_alias/index.html + html/Main/Private/index.html + html/Main/index.html + +and the reference resolves, and links to it: + + $ grep -A4 'val f' html/Main/Foo/index.html + val f : + + + Private.Zone_alias.t + ->