diff options
| -rw-r--r-- | compiler/main/Packages.hs | 54 | ||||
| -rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal07/M.hs | 1 | ||||
| -rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal07/Makefile | 22 | ||||
| -rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal07/P.hsig | 1 | ||||
| -rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal07/Setup.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal07/all.T | 9 | ||||
| -rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal07/bkpcabal07.cabal | 19 |
7 files changed, 88 insertions, 20 deletions
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 5db198be4b..10ef0d42ec 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -471,10 +471,11 @@ initPackages dflags0 = do Nothing -> readPackageConfigs dflags Just db -> return $ map (\(p, pkgs) -> (p, setBatchPackageFlags dflags pkgs)) db - (pkg_state, preload) + (pkg_state, preload, insts) <- mkPackageState dflags pkg_db [] return (dflags{ pkgDatabase = Just pkg_db, - pkgState = pkg_state }, + pkgState = pkg_state, + thisUnitIdInsts_ = insts }, preload) -- ----------------------------------------------------------------------------- @@ -1069,25 +1070,36 @@ findWiredInPackages dflags prec_map pkgs vis_map = do = pkg upd_deps pkg = pkg { -- temporary harmless DefUnitId invariant violation - depends = map (unDefUnitId . upd_wired_in . DefUnitId) (depends pkg), + depends = map (unDefUnitId . upd_wired_in wiredInMap . DefUnitId) (depends pkg), exposedModules - = map (\(k,v) -> (k, fmap upd_wired_in_mod v)) + = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) (exposedModules pkg) } - upd_wired_in_mod (Module uid m) = Module (upd_wired_in_uid uid) m - upd_wired_in_uid (DefiniteUnitId def_uid) = - DefiniteUnitId (upd_wired_in def_uid) - upd_wired_in_uid (IndefiniteUnitId indef_uid) = - IndefiniteUnitId $ newIndefUnitId - (indefUnitIdComponentId indef_uid) - (map (\(x,y) -> (x,upd_wired_in_mod y)) (indefUnitIdInsts indef_uid)) - upd_wired_in key - | Just key' <- Map.lookup key wiredInMap = key' - | otherwise = key return (updateWiredInDependencies pkgs, wiredInMap) +-- Helper functions for rewiring Module and UnitId. These +-- rewrite UnitIds of modules in wired-in packages to the form known to the +-- compiler. For instance, base-4.9.0.0 will be rewritten to just base, to match +-- what appears in PrelNames. + +upd_wired_in_mod :: WiredPackagesMap -> Module -> Module +upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m + +upd_wired_in_uid :: WiredPackagesMap -> UnitId -> UnitId +upd_wired_in_uid wiredInMap (DefiniteUnitId def_uid) = + DefiniteUnitId (upd_wired_in wiredInMap def_uid) +upd_wired_in_uid wiredInMap (IndefiniteUnitId indef_uid) = + IndefiniteUnitId $ newIndefUnitId + (indefUnitIdComponentId indef_uid) + (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (indefUnitIdInsts indef_uid)) + +upd_wired_in :: WiredPackagesMap -> DefUnitId -> DefUnitId +upd_wired_in wiredInMap key + | Just key' <- Map.lookup key wiredInMap = key' + | otherwise = key + updateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap) where f vm (from, to) = case Map.lookup (DefiniteUnitId from) vis_map of @@ -1344,12 +1356,10 @@ mkPackageState -> [(FilePath, [PackageConfig])] -> [PreloadUnitId] -- preloaded packages -> IO (PackageState, - [PreloadUnitId]) -- new packages to preload + [PreloadUnitId], -- new packages to preload + Maybe [(ModuleName, Module)]) mkPackageState dflags dbs preload0 = do - -- Compute the unit id - let this_package = thisPackage dflags - {- Plan. @@ -1541,7 +1551,10 @@ mkPackageState dflags dbs preload0 = do -- but in any case remove the current package from the set of -- preloaded packages so that base/rts does not end up in the -- set up preloaded package when we are just building it - preload3 = nub $ filter (/= this_package) + -- (NB: since this is only relevant for base/rts it doesn't matter + -- that thisUnitIdInsts_ is not wired yet) + -- + preload3 = nub $ filter (/= thisPackage dflags) $ (basicLinkedPackages ++ preload2) -- Close the preload packages with their dependencies @@ -1564,7 +1577,8 @@ mkPackageState dflags dbs preload0 = do unwireMap = Map.fromList [ (v,k) | (k,v) <- Map.toList wired_map ], requirementContext = req_ctx } - return (pstate, new_dep_preload) + let new_insts = fmap (map (fmap (upd_wired_in_mod wired_map))) (thisUnitIdInsts_ dflags) + return (pstate, new_dep_preload, new_insts) -- | Given a wired-in 'UnitId', "unwire" it into the 'UnitId' -- that it was recorded as in the package database. diff --git a/testsuite/tests/backpack/cabal/bkpcabal07/M.hs b/testsuite/tests/backpack/cabal/bkpcabal07/M.hs new file mode 100644 index 0000000000..ef2ad8bb3f --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal07/M.hs @@ -0,0 +1 @@ +module M where diff --git a/testsuite/tests/backpack/cabal/bkpcabal07/Makefile b/testsuite/tests/backpack/cabal/bkpcabal07/Makefile new file mode 100644 index 0000000000..a83f4b9128 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal07/Makefile @@ -0,0 +1,22 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP='$(PWD)/Setup' -v0 +CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' + +# This test checks that instantiating an indefinite package +# with a wired in package works. + +bkpcabal07: clean + $(MAKE) -s --no-print-directory clean + '$(GHC_PKG)' init tmp.d + '$(TEST_HC)' -v0 --make Setup + $(CONFIGURE) + $(SETUP) build +ifneq "$(CLEANUP)" "" + $(MAKE) -s --no-print-directory clean +endif + +clean : + $(RM) -rf tmp.d inst dist Setup$(exeext) diff --git a/testsuite/tests/backpack/cabal/bkpcabal07/P.hsig b/testsuite/tests/backpack/cabal/bkpcabal07/P.hsig new file mode 100644 index 0000000000..cebc90f7a0 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal07/P.hsig @@ -0,0 +1 @@ +signature P where diff --git a/testsuite/tests/backpack/cabal/bkpcabal07/Setup.hs b/testsuite/tests/backpack/cabal/bkpcabal07/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal07/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/backpack/cabal/bkpcabal07/all.T b/testsuite/tests/backpack/cabal/bkpcabal07/all.T new file mode 100644 index 0000000000..d449ab13e4 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal07/all.T @@ -0,0 +1,9 @@ +if config.cleanup: + cleanup = 'CLEANUP=1' +else: + cleanup = 'CLEANUP=0' + +test('bkpcabal07', + extra_files(['bkpcabal07.cabal', 'Setup.hs', 'M.hs', 'P.hsig']), + run_command, + ['$MAKE -s --no-print-directory bkpcabal07 ' + cleanup]) diff --git a/testsuite/tests/backpack/cabal/bkpcabal07/bkpcabal07.cabal b/testsuite/tests/backpack/cabal/bkpcabal07/bkpcabal07.cabal new file mode 100644 index 0000000000..4f66fc44a9 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal07/bkpcabal07.cabal @@ -0,0 +1,19 @@ +name: bkpcabal06 +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=2.0 + +library indef + signatures: P + reexported-modules: Prelude + build-depends: base + default-language: Haskell2010 + +library + exposed-modules: M + build-depends: indef, base + mixins: base (Prelude as P) + default-language: Haskell2010 |