[Git][ghc/ghc][master] Fix unusable units and module reexport interaction (#21097)

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Nov 16 14:58:17 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
cee81370 by Sylvain Henry at 2023-11-16T09:57:46-05:00
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.

- - - - -


19 changed files:

- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/State.hs
- + testsuite/tests/driver/T21097/Makefile
- + testsuite/tests/driver/T21097/T21097.stderr
- + testsuite/tests/driver/T21097/Test.hs
- + testsuite/tests/driver/T21097/all.T
- + testsuite/tests/driver/T21097/pkgdb/a.conf
- + testsuite/tests/driver/T21097/pkgdb/b.conf
- + testsuite/tests/driver/T21097/pkgdb/c.conf
- + testsuite/tests/driver/T21097b/Makefile
- + testsuite/tests/driver/T21097b/T21097b.stdout
- + testsuite/tests/driver/T21097b/Test.hs
- + testsuite/tests/driver/T21097b/all.T
- + testsuite/tests/driver/T21097b/pkgdb/a.conf
- + testsuite/tests/driver/T21097b/pkgdb/b.conf
- + testsuite/tests/driver/T21097b/pkgdb/c.conf


Changes:

=====================================
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
 
 


=====================================
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
 


=====================================
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


=====================================
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
       }


=====================================
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.
 --


=====================================
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


=====================================
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
+  | ^^^^^^^^^^


=====================================
testsuite/tests/driver/T21097/Test.hs
=====================================
@@ -0,0 +1,3 @@
+module Main where
+
+import Foo


=====================================
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, [])


=====================================
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


=====================================
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


=====================================
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


=====================================
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


=====================================
testsuite/tests/driver/T21097b/T21097b.stdout
=====================================
@@ -0,0 +1,5 @@
+
+==================== Module Map ====================
+Foo                                               a-0.1 (exposed package)
+
+


=====================================
testsuite/tests/driver/T21097b/Test.hs
=====================================
@@ -0,0 +1,3 @@
+module Main where
+
+import Foo


=====================================
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, [])


=====================================
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


=====================================
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


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cee81370cd6ef256f66035e3116878d4cb82e28b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cee81370cd6ef256f66035e3116878d4cb82e28b
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231116/a6a18736/attachment-0001.html>


More information about the ghc-commits mailing list