Skip to content

Commit

Permalink
Improve internal error checking to avoid issues like haskell#3428
Browse files Browse the repository at this point in the history
Check that we do get the registration info we expect in a couple places,
and add detail to the error message originally reported in haskell#3428.

Also build the integration tests with assertions on, which might have
caught this error earlier (via the invariant for the install plan).
  • Loading branch information
dcoutts committed May 30, 2016
1 parent ba91989 commit 3d1f5ba
Show file tree
Hide file tree
Showing 3 changed files with 25 additions and 6 deletions.
7 changes: 5 additions & 2 deletions cabal-install/Distribution/Client/InstallPlan.hs
Original file line number Diff line number Diff line change
Expand Up @@ -427,12 +427,15 @@ lookupReadyPackage plan pkg = do
Just (Configured _) -> Nothing
Just (Processing _) -> Nothing
Just (Installed _ (Just ipkg) _) -> Just ipkg
Just (Installed _ Nothing _) -> internalError depOnNonLib
Just (Installed _ Nothing _) -> internalError (depOnNonLib pkgid)
Just (Failed _ _) -> internalError depOnFailed
Nothing -> internalError incomplete
incomplete = "install plan is not closed"
depOnFailed = "configured package depends on failed package"
depOnNonLib = "configured package depends on a non-library package"
depOnNonLib dep = "the configured package "
++ display (packageId pkg)
++ " depends on a non-library package "
++ display dep

-- | Marks packages in the graph as currently processing (e.g. building).
--
Expand Down
22 changes: 19 additions & 3 deletions cabal-install/Distribution/Client/ProjectBuilding.hs
Original file line number Diff line number Diff line change
Expand Up @@ -823,8 +823,19 @@ executeInstallPlan verbosity jobCtl plan0 installPkg =
-> GenericInstallPlan ipkg srcpkg iresult BuildFailure
updatePlan pkg (BuildSuccess ipkgs buildSuccess) =
InstallPlan.completed (installedPackageId pkg)
(find (\ipkg -> installedPackageId ipkg == installedPackageId pkg) ipkgs)
mipkg
buildSuccess
where
mipkg = case (ipkgs, find (\ipkg -> installedPackageId ipkg
== installedPackageId pkg) ipkgs) of
([], _) -> Nothing
((_:_), Just ipkg) -> Just ipkg
((_:_), Nothing) ->
error $ "executeInstallPlan: package " ++ display (packageId pkg)
++ " was expected to register the unit "
++ display (installedPackageId pkg)
++ " but is actually registering the unit(s) "
++ intercalate ", " (map (display . installedPackageId) ipkgs)

updatePlan pkg (BuildFailure buildFailure) =
InstallPlan.failed (installedPackageId pkg) buildFailure depsFailure
Expand Down Expand Up @@ -1025,8 +1036,13 @@ buildAndInstallUnpackedPackage verbosity
-- Case A and B
[ipkg] -> [ipkg { Installed.installedUnitId = ipkgid }]
-- Case C
_ -> assert (any ((== ipkgid) . Installed.installedUnitId)
ipkgs) ipkgs
_ -> ipkgs
unless (any ((== ipkgid) . Installed.installedUnitId) ipkgs') $
die $ "the package " ++ display (packageId pkg) ++ " was expected "
++ " to produce registeration info for the unit Id "
++ display ipkgid ++ " but it actually produced info for "
++ intercalate ", "
(map (display . Installed.installedUnitId) ipkgs')
forM_ ipkgs' $ \ipkg' ->
Cabal.registerPackage verbosity compiler progdb
HcPkg.MultiInstance
Expand Down
2 changes: 1 addition & 1 deletion cabal-install/cabal-install.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -528,7 +528,7 @@ test-suite integration-tests2
type: exitcode-stdio-1.0
main-is: IntegrationTests2.hs
hs-source-dirs: tests, .
ghc-options: -Wall -fwarn-tabs
ghc-options: -Wall -fwarn-tabs -fno-ignore-asserts
other-modules:
build-depends:
async,
Expand Down

0 comments on commit 3d1f5ba

Please sign in to comment.