compareByPreference: handle the integer-gmp vs -simple case
authorAlp Mestanogullari <alp@well-typed.com>
Mon, 12 Nov 2018 14:38:46 +0000 (15:38 +0100)
committerAlp Mestanogullari <alp@well-typed.com>
Mon, 12 Nov 2018 16:50:06 +0000 (17:50 +0100)
Currently, it assumes the package names are identical and this
breaks in the case where integer-gmp is in one package db and
integer-simple in another. This became a problem with
the commit: fc2ff6dd7496a33bf68165b28f37f40b7d647418.

Instead of following the precedence information, leading to
the right choice, the current code would compare the
integer-gmp and integer-simple versions and pick integer-gmp
because it happened to have a greater version, despite having
a lower precedence. See
https://github.com/snowleopard/hadrian/issues/702 for
a comprehensive report about the problem.

This effectively un-breaks integer-simple builds with hadrian.

Test Plan: hadrian/build.sh --integer-simple

Reviewers: snowleopard, bgamari

Reviewed By: bgamari

Subscribers: snowleopard, rwbarton, carter

Differential Revision: https://phabricator.haskell.org/D5266

compiler/main/Packages.hs

index fadcd31..78d5961 100644 (file)
@@ -891,15 +891,28 @@ sortByPreference prec_map = sortBy (flip (compareByPreference prec_map))
 --
 -- Pursuant to #12518, we could change this policy to, for example, remove
 -- the version preference, meaning that we would always prefer the packages
--- in alter package database.
+-- in later package database.
 --
+-- Instead, we use that preference based policy only when one of the packages
+-- is integer-gmp and the other is integer-simple.
+-- This currently only happens when we're looking up which concrete
+-- package to use in place of @integer-wired-in@ and that two different
+-- package databases supply a different integer library. For more about
+-- the fake @integer-wired-in@ package, see Note [The integer library]
+-- in the @PrelNames@ module.
 compareByPreference
     :: PackagePrecedenceIndex
     -> PackageConfig
     -> PackageConfig
     -> Ordering
-compareByPreference prec_map pkg pkg' =
-    case comparing packageVersion pkg pkg' of
+compareByPreference prec_map pkg pkg'
+  | Just prec  <- Map.lookup (unitId pkg)  prec_map
+  , Just prec' <- Map.lookup (unitId pkg') prec_map
+  , differentIntegerPkgs pkg pkg'
+  = compare prec prec'
+
+  | otherwise
+  = case comparing packageVersion pkg pkg' of
         GT -> GT
         EQ | Just prec  <- Map.lookup (unitId pkg)  prec_map
            , Just prec' <- Map.lookup (unitId pkg') prec_map
@@ -910,6 +923,12 @@ compareByPreference prec_map pkg pkg' =
            -> EQ
         LT -> LT
 
+  where isIntegerPkg p = packageNameString p `elem`
+          ["integer-simple", "integer-gmp"]
+        differentIntegerPkgs p p' =
+          isIntegerPkg p && isIntegerPkg p' &&
+          (packageName p /= packageName p')
+
 comparing :: Ord a => (t -> a) -> t -> t -> Ordering
 comparing f a b = f a `compare` f b