diff --git a/compiler/GHC/Iface/Errors/Ppr.hs b/compiler/GHC/Iface/Errors/Ppr.hs
index 6d3cc42b2099ffaaf1af882bd7e459a8d1fc1c05..79fe58519a5eaa22704094bf5ae5acefb82bcd6c 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 9bdac84a3a34510a88ed89a00cb639ce93bef33f..974fc1a5ec306b93a53b4c2220d8ad9ec65d4e4a 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 25d3f68d002d39e7293bd95dae67896409becd5a..c113e2592f92af8e0b3c770278c8152776b9a193 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 d3dad77eda672b8ae10ccd2fd1467510932e2f6f..fceb4b03648c70e1297ab80583ee331522c555c0 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 0d406d407c887fc48e59e2582b06daa6f08029a3..aa16d401a0808ef5f7a39a586d844fb1a6216303 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 0000000000000000000000000000000000000000..b90dcdb3ceabf89ecc376cd088d44dc58d073de5
--- /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 0000000000000000000000000000000000000000..565589c38c3b6b1a032ef03604a25d66e6026892
--- /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 0000000000000000000000000000000000000000..3a3151eb70a8b543b8d41d1e5511c8a4228d6259
--- /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 0000000000000000000000000000000000000000..5b4e4d479000d38bc29095d0ede10fe2727278a8
--- /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 0000000000000000000000000000000000000000..108cbe35430a1853e1a16ddb2c8706d5fdbe8291
--- /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 0000000000000000000000000000000000000000..abffed2fc18783b5e0aea991fc24a9f0cd01e705
--- /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 0000000000000000000000000000000000000000..b183748777e5c5baa41f1a360ef696aea05550d2
--- /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 0000000000000000000000000000000000000000..6455817a300f2c8188e14e897bbb4feda141bf36
--- /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 0000000000000000000000000000000000000000..e0380edd6c4009a9cd641755524dbc516e387966
--- /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 0000000000000000000000000000000000000000..3a3151eb70a8b543b8d41d1e5511c8a4228d6259
--- /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 0000000000000000000000000000000000000000..ee47c0610ee28eb982664482e60fa21829874b54
--- /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 0000000000000000000000000000000000000000..b76d54fc287647946c374a376394e44b84c35099
--- /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 0000000000000000000000000000000000000000..264b05bea2b52d7c51e661a93cde283d4f7c2704
--- /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 0000000000000000000000000000000000000000..b183748777e5c5baa41f1a360ef696aea05550d2
--- /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