Commit 856cdb9d authored by Michael Peyton Jones's avatar Michael Peyton Jones Committed by Ben Gamari
Browse files

Visibility: handle multiple units with the same name

Fixes #16228. The included test case is adapted from the reproduction in
the issue, and fails without this patch.


We compute an initial visilibity mapping for units based on what is
present in the package databases. To seed this, we compute a set of all
the package configs to add visibilities for.

However, this set was keyed off the unit's *package name*. This is
correct, since we compare packages across databases by version. However,
we would only ever consider a single, most-preferable unit from the
database in which it was found.

The effect of this was that only one of the libraries in a Cabal package
would be added to this initial set. This would cause attempts to use
modules from the omitted libraries to fail, claiming that the package
was hidden (even though `ghc-pkg` would correctly show it as visible).

A solution is to do the selection of the most preferable packages
separately, and then be sure to consider exposing all units in the
same package in the same package db. We can do this by picking a
most-preferable unit for each package name, and then considering
exposing all units that are equi-preferable with that unit.


Why wasn't this bug apparent to all people trying to use sub-libraries
in Cabal? The answer is that Cabal explicitly passes `-package` and
`-package-id` flags for all the packages it wants to use, rather than
relying on the state of the package database. So this bug only really
affects people who are trying to use package databases produced by Cabal
outside of Cabal itself.

One particular example of this is the way that the
Nixpkgs Haskell infrastructure provides wrapped GHCs: typically these
are equipped with a package database containing all the needed
package dependencies, and the user is not expected to pass
`-package` flags explicitly.

(cherry picked from commit 8a20bfc2)
parent 7c9c129e
......@@ -1456,23 +1456,42 @@ mkPackageState dflags dbs preload0 = do
let prelim_pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs1
-- Calculate the initial set of packages, prior to any package flags.
-- This set contains the latest version of all valid (not unusable) packages,
-- or is empty if we have -hide-all-packages
-- Calculate the initial set of units from package databases, prior to any package flags.
let preferLater pkg pkg' =
case compareByPreference prec_map pkg pkg' of
GT -> pkg
_ -> pkg'
calcInitial m pkg = addToUDFM_C preferLater m (fsPackageName pkg) pkg
initial = if gopt Opt_HideAllPackages dflags
-- Conceptually, we select the latest versions of all valid (not unusable) *packages*
-- (not units). This is empty if we have -hide-all-packages.
-- Then we create an initial visibility map with default visibilities for all
-- exposed, definite units which belong to the latest valid packages.
let preferLater unit unit' =
case compareByPreference prec_map unit unit' of
GT -> unit
_ -> unit'
addIfMorePreferable m unit = addToUDFM_C preferLater m (fsPackageName unit) unit
-- This is the set of maximally preferable packages. In fact, it is a set of
-- most preferable *units* keyed by package name, which act as stand-ins in
-- for "a package in a database". We use units here because we don't have
-- "a package in a database" as a type currently.
mostPreferablePackageReps = if gopt Opt_HideAllPackages dflags
then emptyUDFM
else foldl' calcInitial emptyUDFM pkgs1
vis_map1 = foldUDFM (\p vm ->
else foldl' addIfMorePreferable emptyUDFM pkgs1
-- When exposing units, we want to consider all of those in the most preferable
-- packages. We can implement that by looking for units that are equi-preferable
-- with the most preferable unit for package. Being equi-preferable means that
-- they must be in the same database, with the same version, and the same pacakge name.
-- We must take care to consider all these units and not just the most
-- preferable one, otherwise we can end up with problems like #16228.
mostPreferable u =
case lookupUDFM mostPreferablePackageReps (fsPackageName u) of
Nothing -> False
Just u' -> compareByPreference prec_map u u' == EQ
vis_map1 = foldl' (\vm p ->
-- Note: we NEVER expose indefinite packages by
-- default, because it's almost assuredly not
-- what you want (no mix-in linking has occurred).
if exposed p && unitIdIsDefinite (packageConfigId p)
if exposed p && unitIdIsDefinite (packageConfigId p) && mostPreferable p
then Map.insert (packageConfigId p)
UnitVisibility {
uv_expose_all = True,
......@@ -1483,7 +1502,7 @@ mkPackageState dflags dbs preload0 = do
else vm)
Map.empty initial
Map.empty pkgs1
-- Compute a visibility map according to the command-line flags (-package,
include $(TOP)/mk/
include $(TOP)/mk/
SETUP = ./Setup -v0
# This test is for packages in internal libraries
cabal10: clean
$(MAKE) clean
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup
$(SETUP) clean
$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)'
$(SETUP) build
'$(TEST_HC)' $(TEST_HC_OPTS) -package-db dist/package.conf.inplace Use.hs
ifneq "$(CLEANUP)" ""
$(MAKE) clean
clean :
$(RM) -r */dist Setup$(exeext) *.o *.hi
import Distribution.Simple
main = defaultMain
module Use where
import TestLib
if config.cleanup:
cleanup = 'CLEANUP=1'
cleanup = 'CLEANUP=0'
extra_files(['Use.hs', 'Setup.hs', 'src/', 'internal-lib.cabal']),
['$MAKE -s --no-print-directory cabal10 ' + cleanup])
[1 of 1] Compiling Use ( Use.hs, Use.o )
name: internal-lib
license: BSD3
build-type: Simple
cabal-version: >=2.0
hs-source-dirs: src
exposed-modules: TestLib
build-depends: base
default-language: Haskell2010
library sublib
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment