From cee81370cd6ef256f66035e3116878d4cb82e28b Mon Sep 17 00:00:00 2001 From: Sylvain Henry <sylvain@haskus.fr> Date: Wed, 21 Jun 2023 18:40:09 +0200 Subject: [PATCH] Fix unusable units and module reexport interaction (#21097) This commit fixes an issue with ModUnusable introduced in df0f148feae. In mkUnusableModuleNameProvidersMap we traverse the list of unusable units and generate ModUnusable origin for all the modules they contain: exposed modules, hidden modules, and also re-exported modules. To do this we have a two-level map: ModuleName -> Unit:ModuleName (aka Module) -> ModuleOrigin So for each module name "M" in broken unit "u" we have: "M" -> u:M -> ModUnusable reason However in the case of module reexports we were using the *target* module as a key. E.g. if "u:M" is a reexport for "X" from unit "o": "M" -> o:X -> ModUnusable reason Case 1: suppose a reexport without module renaming (u:M -> o:M) from unusable unit u: "M" -> o:M -> ModUnusable reason Here it's claiming that the import of M is unusable because a reexport from u is unusable. But if unit o isn't unusable we could also have in the map: "M" -> o:M -> ModOrigin ... Issue: the Semigroup instance of ModuleOrigin doesn't handle the case (ModUnusable <> ModOrigin) Case 2: similarly we could have 2 unusable units reexporting the same module without renaming, say (u:M -> o:M) and (v:M -> o:M) with u and v unusable. It gives: "M" -> o:M -> ModUnusable ... (for u) "M" -> o:M -> ModUnusable ... (for v) Issue: the Semigroup instance of ModuleOrigin doesn't handle the case (ModUnusable <> ModUnusable). This led to #21097, #16996, #11050. To fix this, in this commit we make ModUnusable track whether the module used as key is a reexport or not (for better error messages) and we use the re-export module as key. E.g. if "u:M" is a reexport for "o:X" and u is unusable, we now record: "M" -> u:M -> ModUnusable reason reexported=True So now, we have two cases for a reexport u:M -> o:X: - u unusable: "M" -> u:M -> ModUnusable ... reexported=True - u usable: "M" -> o:X -> ModOrigin ... reexportedFrom=u:M The second case is indexed with o:X because in this case the Semigroup instance of ModOrigin is used to combine valid expositions of a module (directly or via reexports). Note that module lookup functions select usable modules first (those who have a ModOrigin value), so it doesn't matter if we add new ModUnusable entries in the map like this: "M" -> { u:M -> ModUnusable ... reexported=True o:M -> ModOrigin ... } The ModOrigin one will be used. Only if there is no ModOrigin or ModHidden entry will the ModUnusable error be printed. See T21097 for an example printing several reasons why an import is unusable. --- compiler/GHC/Iface/Errors/Ppr.hs | 7 +-- compiler/GHC/Iface/Errors/Types.hs | 4 +- compiler/GHC/Unit/Finder.hs | 2 +- compiler/GHC/Unit/Finder/Types.hs | 2 +- compiler/GHC/Unit/State.hs | 52 ++++++++++++++----- testsuite/tests/driver/T21097/Makefile | 7 +++ testsuite/tests/driver/T21097/T21097.stderr | 16 ++++++ testsuite/tests/driver/T21097/Test.hs | 3 ++ testsuite/tests/driver/T21097/all.T | 4 ++ testsuite/tests/driver/T21097/pkgdb/a.conf | 12 +++++ testsuite/tests/driver/T21097/pkgdb/b.conf | 12 +++++ testsuite/tests/driver/T21097/pkgdb/c.conf | 12 +++++ testsuite/tests/driver/T21097b/Makefile | 7 +++ testsuite/tests/driver/T21097b/T21097b.stdout | 5 ++ testsuite/tests/driver/T21097b/Test.hs | 3 ++ testsuite/tests/driver/T21097b/all.T | 6 +++ testsuite/tests/driver/T21097b/pkgdb/a.conf | 10 ++++ testsuite/tests/driver/T21097b/pkgdb/b.conf | 12 +++++ testsuite/tests/driver/T21097b/pkgdb/c.conf | 12 +++++ 19 files changed, 168 insertions(+), 20 deletions(-) create mode 100644 testsuite/tests/driver/T21097/Makefile create mode 100644 testsuite/tests/driver/T21097/T21097.stderr create mode 100644 testsuite/tests/driver/T21097/Test.hs create mode 100644 testsuite/tests/driver/T21097/all.T create mode 100644 testsuite/tests/driver/T21097/pkgdb/a.conf create mode 100644 testsuite/tests/driver/T21097/pkgdb/b.conf create mode 100644 testsuite/tests/driver/T21097/pkgdb/c.conf create mode 100644 testsuite/tests/driver/T21097b/Makefile create mode 100644 testsuite/tests/driver/T21097b/T21097b.stdout create mode 100644 testsuite/tests/driver/T21097b/Test.hs create mode 100644 testsuite/tests/driver/T21097b/all.T create mode 100644 testsuite/tests/driver/T21097b/pkgdb/a.conf create mode 100644 testsuite/tests/driver/T21097b/pkgdb/b.conf create mode 100644 testsuite/tests/driver/T21097b/pkgdb/c.conf diff --git a/compiler/GHC/Iface/Errors/Ppr.hs b/compiler/GHC/Iface/Errors/Ppr.hs index 6d3cc42b2099..79fe58519a5e 100644 --- a/compiler/GHC/Iface/Errors/Ppr.hs +++ b/compiler/GHC/Iface/Errors/Ppr.hs @@ -279,9 +279,10 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst mod_hidden pkg = text "it is a hidden module in the package" <+> quotes (ppr pkg) - unusable (pkg, reason) - = text "It is a member of the package" - <+> quotes (ppr pkg) + unusable (UnusableUnit unit reason reexport) + = text "It is " <> (if reexport then text "reexported from the package" + else text "a member of the package") + <+> quotes (ppr unit) $$ pprReason (text "which is") reason diff --git a/compiler/GHC/Iface/Errors/Types.hs b/compiler/GHC/Iface/Errors/Types.hs index 9bdac84a3a34..974fc1a5ec30 100644 --- a/compiler/GHC/Iface/Errors/Types.hs +++ b/compiler/GHC/Iface/Errors/Types.hs @@ -25,7 +25,7 @@ import GHC.Prelude import GHC.Types.Name (Name) import GHC.Types.TyThing (TyThing) import GHC.Unit.Types (Module, InstalledModule, UnitId, Unit) -import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo) +import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnit, UnitInfo) import GHC.Exception.Type (SomeException) import GHC.Unit.Types ( IsBootInterface ) import Language.Haskell.Syntax.Module.Name ( ModuleName ) @@ -80,7 +80,7 @@ data CantFindInstalledReason | CouldntFindInFiles [FilePath] | GenericMissing [(Unit, Maybe UnitInfo)] [Unit] - [(Unit, UnusableUnitReason)] [FilePath] + [UnusableUnit] [FilePath] | MultiplePackages [(Module, ModuleOrigin)] deriving Generic diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs index 25d3f68d002d..c113e2592f92 100644 --- a/compiler/GHC/Unit/Finder.hs +++ b/compiler/GHC/Unit/Finder.hs @@ -301,7 +301,7 @@ findLookupResult fc fopts r = case r of , fr_suggestions = [] }) LookupUnusable unusable -> let unusables' = map get_unusable unusable - get_unusable (m, ModUnusable r) = (moduleUnit m, r) + get_unusable (_, ModUnusable r) = r get_unusable (_, r) = pprPanic "findLookupResult: unexpected origin" (ppr r) in return (NotFound{ fr_paths = [], fr_pkg = Nothing diff --git a/compiler/GHC/Unit/Finder/Types.hs b/compiler/GHC/Unit/Finder/Types.hs index d3dad77eda67..fceb4b03648c 100644 --- a/compiler/GHC/Unit/Finder/Types.hs +++ b/compiler/GHC/Unit/Finder/Types.hs @@ -61,7 +61,7 @@ data FindResult -- but the *unit* is hidden -- | Module is in these units, but it is unusable - , fr_unusables :: [(Unit, UnusableUnitReason)] + , fr_unusables :: [UnusableUnit] , fr_suggestions :: [ModuleSuggestion] -- ^ Possible mis-spelled modules } diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index 0d406d407c88..aa16d401a080 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -43,6 +43,7 @@ module GHC.Unit.State ( LookupResult(..), ModuleSuggestion(..), ModuleOrigin(..), + UnusableUnit(..), UnusableUnitReason(..), pprReason, @@ -173,8 +174,10 @@ data ModuleOrigin = -- (But maybe the user didn't realize), so we'll still keep track -- of these modules.) ModHidden - -- | Module is unavailable because the package is unusable. - | ModUnusable UnusableUnitReason + + -- | Module is unavailable because the unit is unusable. + | ModUnusable !UnusableUnit + -- | Module is public, and could have come from some places. | ModOrigin { -- | @Just False@ means that this module is in @@ -192,6 +195,13 @@ data ModuleOrigin = , fromPackageFlag :: Bool } +-- | A unusable unit module origin +data UnusableUnit = UnusableUnit + { uuUnit :: !Unit -- ^ Unusable unit + , uuReason :: !UnusableUnitReason -- ^ Reason + , uuIsReexport :: !Bool -- ^ Is the "module" a reexport? + } + instance Outputable ModuleOrigin where ppr ModHidden = text "hidden module" ppr (ModUnusable _) = text "unusable module" @@ -236,7 +246,8 @@ instance Semigroup ModuleOrigin where text "x: " <> ppr x $$ text "y: " <> ppr y g Nothing x = x g x Nothing = x - x <> y = pprPanic "ModOrigin: hidden module redefined" $ + + x <> y = pprPanic "ModOrigin: module origin mismatch" $ text "x: " <> ppr x $$ text "y: " <> ppr y instance Monoid ModuleOrigin where @@ -1818,21 +1829,36 @@ mkUnusableModuleNameProvidersMap :: UnusableUnits -> ModuleNameProvidersMap mkUnusableModuleNameProvidersMap unusables = nonDetFoldUniqMap extend_modmap emptyUniqMap unusables where - extend_modmap (_uid, (pkg, reason)) modmap = addListTo modmap bindings + extend_modmap (_uid, (unit_info, reason)) modmap = addListTo modmap bindings where bindings :: [(ModuleName, UniqMap Module ModuleOrigin)] bindings = exposed ++ hidden - origin = ModUnusable reason - pkg_id = mkUnit pkg + origin_reexport = ModUnusable (UnusableUnit unit reason True) + origin_normal = ModUnusable (UnusableUnit unit reason False) + unit = mkUnit unit_info exposed = map get_exposed exposed_mods - hidden = [(m, mkModMap pkg_id m origin) | m <- hidden_mods] - - get_exposed (mod, Just mod') = (mod, unitUniqMap mod' origin) - get_exposed (mod, _) = (mod, mkModMap pkg_id mod origin) - - exposed_mods = unitExposedModules pkg - hidden_mods = unitHiddenModules pkg + hidden = [(m, mkModMap unit m origin_normal) | m <- hidden_mods] + + -- with re-exports, c:Foo can be reexported from two (or more) + -- unusable packages: + -- Foo -> a:Foo (unusable reason A) -> c:Foo + -- -> b:Foo (unusable reason B) -> c:Foo + -- + -- We must be careful to not record the following (#21097): + -- Foo -> c:Foo (unusable reason A) + -- -> c:Foo (unusable reason B) + -- But: + -- Foo -> a:Foo (unusable reason A) + -- -> b:Foo (unusable reason B) + -- + get_exposed (mod, Just _) = (mod, mkModMap unit mod origin_reexport) + get_exposed (mod, _) = (mod, mkModMap unit mod origin_normal) + -- in the reexport case, we create a virtual module that doesn't + -- exist but we don't care as it's only used as a key in the map. + + exposed_mods = unitExposedModules unit_info + hidden_mods = unitHiddenModules unit_info -- | Add a list of key/value pairs to a nested map. -- diff --git a/testsuite/tests/driver/T21097/Makefile b/testsuite/tests/driver/T21097/Makefile new file mode 100644 index 000000000000..b90dcdb3ceab --- /dev/null +++ b/testsuite/tests/driver/T21097/Makefile @@ -0,0 +1,7 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T21097: + '$(GHC_PKG)' recache --package-db pkgdb + - '$(TEST_HC)' -package-db pkgdb -v0 Test.hs; test $$? -eq 2 diff --git a/testsuite/tests/driver/T21097/T21097.stderr b/testsuite/tests/driver/T21097/T21097.stderr new file mode 100644 index 000000000000..565589c38c3b --- /dev/null +++ b/testsuite/tests/driver/T21097/T21097.stderr @@ -0,0 +1,16 @@ + +Test.hs:3:1: error: [GHC-87110] + Could not load module ‘Foo’. + It is a member of the package ‘c-0.1’ + which is unusable due to missing dependencies: + d-0.1 + It is reexported from the package ‘b-0.1’ + which is unusable due to missing dependencies: + c-0.1 + It is reexported from the package ‘a-0.1’ + which is unusable due to missing dependencies: + c-0.1 + Use -v to see a list of the files searched for. + | +3 | import Foo + | ^^^^^^^^^^ diff --git a/testsuite/tests/driver/T21097/Test.hs b/testsuite/tests/driver/T21097/Test.hs new file mode 100644 index 000000000000..3a3151eb70a8 --- /dev/null +++ b/testsuite/tests/driver/T21097/Test.hs @@ -0,0 +1,3 @@ +module Main where + +import Foo diff --git a/testsuite/tests/driver/T21097/all.T b/testsuite/tests/driver/T21097/all.T new file mode 100644 index 000000000000..5b4e4d479000 --- /dev/null +++ b/testsuite/tests/driver/T21097/all.T @@ -0,0 +1,4 @@ +# Package a and b both depend on c which is broken (depends on non-existing d) +test('T21097', + [ extra_files(["pkgdb", "pkgdb/a.conf", "pkgdb/b.conf", "pkgdb/c.conf", "Test.hs"]) + ], makefile_test, []) diff --git a/testsuite/tests/driver/T21097/pkgdb/a.conf b/testsuite/tests/driver/T21097/pkgdb/a.conf new file mode 100644 index 000000000000..108cbe35430a --- /dev/null +++ b/testsuite/tests/driver/T21097/pkgdb/a.conf @@ -0,0 +1,12 @@ +name: a +version: 0.1 +visibility: public +id: a-0.1 +key: a-0.1 +abi: 4e313a9f18a8df7d71cc2283205935c4 +exposed: True + +exposed-modules: + Foo from c-0.1:Foo + +depends: c-0.1 diff --git a/testsuite/tests/driver/T21097/pkgdb/b.conf b/testsuite/tests/driver/T21097/pkgdb/b.conf new file mode 100644 index 000000000000..abffed2fc187 --- /dev/null +++ b/testsuite/tests/driver/T21097/pkgdb/b.conf @@ -0,0 +1,12 @@ +name: b +version: 0.1 +visibility: public +id: b-0.1 +key: b-0.1 +abi: 4e313a9f18a8df7d71cc2283205935c4 +exposed: True + +exposed-modules: + Foo from c-0.1:Foo + +depends: c-0.1 diff --git a/testsuite/tests/driver/T21097/pkgdb/c.conf b/testsuite/tests/driver/T21097/pkgdb/c.conf new file mode 100644 index 000000000000..b183748777e5 --- /dev/null +++ b/testsuite/tests/driver/T21097/pkgdb/c.conf @@ -0,0 +1,12 @@ +name: c +version: 0.1 +visibility: public +id: c-0.1 +key: c-0.1 +abi: 4e313a9f18a8df7d71cc2283205935c4 +exposed: True + +exposed-modules: + Foo + +depends: d-0.1 diff --git a/testsuite/tests/driver/T21097b/Makefile b/testsuite/tests/driver/T21097b/Makefile new file mode 100644 index 000000000000..6455817a300f --- /dev/null +++ b/testsuite/tests/driver/T21097b/Makefile @@ -0,0 +1,7 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T21097b: + '$(GHC_PKG)' recache --package-db pkgdb + '$(TEST_HC)' -no-global-package-db -no-user-package-db -package-db pkgdb -v0 Test.hs -ddump-mod-map diff --git a/testsuite/tests/driver/T21097b/T21097b.stdout b/testsuite/tests/driver/T21097b/T21097b.stdout new file mode 100644 index 000000000000..e0380edd6c40 --- /dev/null +++ b/testsuite/tests/driver/T21097b/T21097b.stdout @@ -0,0 +1,5 @@ + +==================== Module Map ==================== +Foo a-0.1 (exposed package) + + diff --git a/testsuite/tests/driver/T21097b/Test.hs b/testsuite/tests/driver/T21097b/Test.hs new file mode 100644 index 000000000000..3a3151eb70a8 --- /dev/null +++ b/testsuite/tests/driver/T21097b/Test.hs @@ -0,0 +1,3 @@ +module Main where + +import Foo diff --git a/testsuite/tests/driver/T21097b/all.T b/testsuite/tests/driver/T21097b/all.T new file mode 100644 index 000000000000..ee47c0610ee2 --- /dev/null +++ b/testsuite/tests/driver/T21097b/all.T @@ -0,0 +1,6 @@ +# Package b is unusable (broken dependency) and reexport Foo from a (which is usable) +test('T21097b', + [ extra_files(["pkgdb", "pkgdb/a.conf", "pkgdb/b.conf", "Test.hs"]) + , ignore_stderr + , exit_code(2) + ], makefile_test, []) diff --git a/testsuite/tests/driver/T21097b/pkgdb/a.conf b/testsuite/tests/driver/T21097b/pkgdb/a.conf new file mode 100644 index 000000000000..b76d54fc2876 --- /dev/null +++ b/testsuite/tests/driver/T21097b/pkgdb/a.conf @@ -0,0 +1,10 @@ +name: a +version: 0.1 +visibility: public +id: a-0.1 +key: a-0.1 +abi: 4e313a9f18a8df7d71cc2283205935c4 +exposed: True + +exposed-modules: + Foo diff --git a/testsuite/tests/driver/T21097b/pkgdb/b.conf b/testsuite/tests/driver/T21097b/pkgdb/b.conf new file mode 100644 index 000000000000..264b05bea2b5 --- /dev/null +++ b/testsuite/tests/driver/T21097b/pkgdb/b.conf @@ -0,0 +1,12 @@ +name: b +version: 0.1 +visibility: public +id: b-0.1 +key: b-0.1 +abi: 4e313a9f18a8df7d71cc2283205935c4 +exposed: True + +exposed-modules: + Foo from a-0.1:Foo + +depends: a-0.1, missing-0.1 diff --git a/testsuite/tests/driver/T21097b/pkgdb/c.conf b/testsuite/tests/driver/T21097b/pkgdb/c.conf new file mode 100644 index 000000000000..b183748777e5 --- /dev/null +++ b/testsuite/tests/driver/T21097b/pkgdb/c.conf @@ -0,0 +1,12 @@ +name: c +version: 0.1 +visibility: public +id: c-0.1 +key: c-0.1 +abi: 4e313a9f18a8df7d71cc2283205935c4 +exposed: True + +exposed-modules: + Foo + +depends: d-0.1 -- GitLab