Commit f59bab10 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Fix three bugs with fake-map implementation for PackageIndex.



1. When we union PackageIndexes together, prefer the later one.
   This idiom is used when we update the processing-state of
   packages in an InstallPlan.

2. dependencyInconsistencies' was missing a number of indirections
   through the fakeMap, so in some cases we incorrectly concluded
   packages were not equal when they were.

3. We need to initialize the fakeMap with any pre-installed packages,
   otherwise the invariant check for configured-packages will fail.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 6f74cee7
...@@ -247,7 +247,7 @@ fromList pkgs = mkPackageIndex pids pnames ...@@ -247,7 +247,7 @@ fromList pkgs = mkPackageIndex pids pnames
-- --
merge :: PackageInstalled a => PackageIndex a -> PackageIndex a -> PackageIndex a merge :: PackageInstalled a => PackageIndex a -> PackageIndex a -> PackageIndex a
merge (PackageIndex pids1 pnames1) (PackageIndex pids2 pnames2) = merge (PackageIndex pids1 pnames1) (PackageIndex pids2 pnames2) =
mkPackageIndex (Map.union pids1 pids2) mkPackageIndex (Map.unionWith (\_ y -> y) pids1 pids2)
(Map.unionWith (Map.unionWith mergeBuckets) pnames1 pnames2) (Map.unionWith (Map.unionWith mergeBuckets) pnames1 pnames2)
where where
-- Packages in the second list mask those in the first, however preferred -- Packages in the second list mask those in the first, however preferred
...@@ -655,7 +655,7 @@ dependencyInconsistencies' fakeMap index = ...@@ -655,7 +655,7 @@ dependencyInconsistencies' fakeMap index =
[ (packageName dep, [ (packageName dep,
Map.fromList [(ipid,(dep,[packageId pkg]))]) Map.fromList [(ipid,(dep,[packageId pkg]))])
| pkg <- allPackages index | pkg <- allPackages index
, ipid <- installedDepends pkg , ipid <- fakeInstalledDepends fakeMap pkg
, Just dep <- [fakeLookupInstalledPackageId fakeMap index ipid] , Just dep <- [fakeLookupInstalledPackageId fakeMap index ipid]
] ]
...@@ -663,8 +663,10 @@ dependencyInconsistencies' fakeMap index = ...@@ -663,8 +663,10 @@ dependencyInconsistencies' fakeMap index =
reallyIsInconsistent [] = False reallyIsInconsistent [] = False
reallyIsInconsistent [_p] = False reallyIsInconsistent [_p] = False
reallyIsInconsistent [p1, p2] = reallyIsInconsistent [p1, p2] =
installedPackageId p1 `notElem` fakeInstalledDepends fakeMap p2 let pid1 = installedPackageId p1
&& installedPackageId p2 `notElem` fakeInstalledDepends fakeMap p1 pid2 = installedPackageId p2
in Map.findWithDefault pid1 pid1 fakeMap `notElem` fakeInstalledDepends fakeMap p2
&& Map.findWithDefault pid2 pid2 fakeMap `notElem` fakeInstalledDepends fakeMap p1
reallyIsInconsistent _ = True reallyIsInconsistent _ = True
-- | Variant of 'installedDepends' which accepts a 'FakeMap'. See Note [FakeMap]. -- | Variant of 'installedDepends' which accepts a 'FakeMap'. See Note [FakeMap].
......
...@@ -49,7 +49,7 @@ import Distribution.Client.Types ...@@ -49,7 +49,7 @@ import Distribution.Client.Types
( SourcePackage(packageDescription), ConfiguredPackage(..) ( SourcePackage(packageDescription), ConfiguredPackage(..)
, ReadyPackage(..), readyPackageToConfiguredPackage , ReadyPackage(..), readyPackageToConfiguredPackage
, InstalledPackage, BuildFailure, BuildSuccess(..), enableStanzas , InstalledPackage, BuildFailure, BuildSuccess(..), enableStanzas
, InstalledPackage(..) ) , InstalledPackage(..), fakeInstalledPackageId )
import Distribution.Package import Distribution.Package
( PackageIdentifier(..), PackageName(..), Package(..), packageName ( PackageIdentifier(..), PackageName(..), Package(..), packageName
, PackageFixedDeps(..), Dependency(..), InstalledPackageId , PackageFixedDeps(..), Dependency(..), InstalledPackageId
...@@ -194,10 +194,18 @@ internalError msg = error $ "InstallPlan: internal error: " ++ msg ...@@ -194,10 +194,18 @@ internalError msg = error $ "InstallPlan: internal error: " ++ msg
new :: Platform -> CompilerId -> PlanIndex new :: Platform -> CompilerId -> PlanIndex
-> Either [PlanProblem] InstallPlan -> Either [PlanProblem] InstallPlan
new platform compiler index = new platform compiler index =
case problems platform compiler Map.empty index of -- NB: Need to pre-initialize the fake-map with pre-existing
-- packages
let isPreExisting (PreExisting _) = True
isPreExisting _ = False
fakeMap = Map.fromList
. map (\p -> (fakeInstalledPackageId (packageId p), installedPackageId p))
. filter isPreExisting
$ PackageIndex.allPackages index in
case problems platform compiler fakeMap index of
[] -> Right InstallPlan { [] -> Right InstallPlan {
planIndex = index, planIndex = index,
planFakeMap = Map.empty, planFakeMap = fakeMap,
planGraph = graph, planGraph = graph,
planGraphRev = Graph.transposeG graph, planGraphRev = Graph.transposeG graph,
planPkgOf = vertexToPkgId, planPkgOf = vertexToPkgId,
......
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