diff --git a/CHANGES.md b/CHANGES.md index a2602e4f12..9b291c5ac2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,7 @@ (@jonludlam, #1427) - Fix #1429, which broke docs in packages including `merlin-lib` (@jonludlam, #1430) +- Fix #1431, a regression introduced in v3.2.0 (#1433, @jonludlam) # 3.2.0 diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml index 9e25ac5299..b0e33e2405 100644 --- a/src/xref2/tools.ml +++ b/src/xref2/tools.ml @@ -2356,25 +2356,32 @@ let apply_inner_substs env (sg : Component.Signature.t) : Component.Signature.t let rec inner (items : Component.Signature.item list) : Component.Signature.item list = match items with - | Component.Signature.TypeSubstitution (id, typedecl) :: rest -> ( + | (Component.Signature.TypeSubstitution (id, typedecl) as orig) :: rest -> ( let subst = Component.ModuleType.TypeSubst (`Dot (`Root, Ident.Name.type_ id), typedecl.equation) in - let rest = + let rest' = inner rest in + let inlined = Component.Signature.Type (id, Ordinary, Component.Delayed.put (fun () -> typedecl)) - :: inner rest + :: rest' in - match fragmap env subst { sg with items = rest } with + match fragmap env subst { sg with items = inlined } with | Ok sg' -> sg'.items - | Error _ -> failwith "error") - | Component.Signature.ModuleSubstitution (id, modsubst) :: rest -> ( + | Error e -> + Lookup_failures.report_internal + "apply_inner_substs: fragmap failed: %a" Errors.Tools_error.pp + (e :> Errors.Tools_error.any); + orig :: rest') + | (Component.Signature.ModuleSubstitution (id, modsubst) as orig) :: rest + -> ( let subst = Component.ModuleType.ModuleSubst (`Dot (`Root, Ident.Name.module_ id), modsubst.manifest) in - let rest = + let rest' = inner rest in + let inlined = Component.Signature.Module ( id, Ordinary, @@ -2386,17 +2393,23 @@ let apply_inner_substs env (sg : Component.Signature.t) : Component.Signature.t canonical = None; hidden = false; }) ) - :: inner rest + :: rest' in - match fragmap env subst { sg with items = rest } with + match fragmap env subst { sg with items = inlined } with | Ok sg' -> sg'.items - | Error _ -> failwith "error") - | Component.Signature.ModuleTypeSubstitution (id, modtypesubst) :: rest -> ( + | Error e -> + Lookup_failures.report_internal + "apply_inner_substs: fragmap failed: %a" Errors.Tools_error.pp + (e :> Errors.Tools_error.any); + orig :: rest') + | (Component.Signature.ModuleTypeSubstitution (id, modtypesubst) as orig) + :: rest -> ( let subst = Component.ModuleType.ModuleTypeSubst (`Dot (`Root, Ident.Name.module_type id), modtypesubst.manifest) in - let rest = + let rest' = inner rest in + let inlined = Component.Signature.ModuleType ( id, Component.Delayed.put (fun () -> @@ -2406,11 +2419,15 @@ let apply_inner_substs env (sg : Component.Signature.t) : Component.Signature.t expr = Some modtypesubst.manifest; canonical = None; }) ) - :: inner rest + :: rest' in - match fragmap env subst { sg with items = rest } with + match fragmap env subst { sg with items = inlined } with | Ok sg' -> sg'.items - | Error _ -> failwith "error") + | Error e -> + Lookup_failures.report_internal + "apply_inner_substs: fragmap failed: %a" Errors.Tools_error.pp + (e :> Errors.Tools_error.any); + orig :: rest') | x :: rest -> x :: inner rest | [] -> [] in diff --git a/test/xref2/dune b/test/xref2/dune index 4134c6b961..7265ca085a 100644 --- a/test/xref2/dune +++ b/test/xref2/dune @@ -43,6 +43,7 @@ js_stack_overflow expansion github_issue_1066 + github_issue_1431 include_module_type_of_preamble) (enabled_if (>= %{ocaml_version} 4.08.0))) diff --git a/test/xref2/github_issue_1431.t/legacy.mli b/test/xref2/github_issue_1431.t/legacy.mli new file mode 100644 index 0000000000..5da2bb59d3 --- /dev/null +++ b/test/xref2/github_issue_1431.t/legacy.mli @@ -0,0 +1,13 @@ +(** A signature with a sibling module declaration and a destructive module + substitution whose manifest references that sibling. + + When this signature is loaded as the expansion of [include module type of + Legacy] elsewhere, [Of_Lang] rewrites internal cross-references to local + idents — so the manifest of [Original_components] becomes a + [`Resolved (`Local _)] path. *) + +module Components : sig + type t +end + +module Original_components := Components diff --git a/test/xref2/github_issue_1431.t/run.t b/test/xref2/github_issue_1431.t/run.t new file mode 100644 index 0000000000..66ff8ea862 --- /dev/null +++ b/test/xref2/github_issue_1431.t/run.t @@ -0,0 +1,9 @@ +Repro of #1431. The unresolvable substitution is logged as a non-fatal +internal warning rather than triggering an assertion failure. + + $ ocamlc -bin-annot -c legacy.mli + $ ocamlc -bin-annot -c top.mli + $ odoc compile legacy.cmti + $ odoc compile -I . top.cmti + File "top.cmti": + Warning: apply_inner_substs: fragmap failed: Unresolved module path resolved(Components/2) (Local id found: Components/2) diff --git a/test/xref2/github_issue_1431.t/top.mli b/test/xref2/github_issue_1431.t/top.mli new file mode 100644 index 0000000000..0d8083cc1a --- /dev/null +++ b/test/xref2/github_issue_1431.t/top.mli @@ -0,0 +1 @@ +include module type of Legacy