Merge pull request #3470 from dcoutts/issue-3428

Fix issue #3428
haskell · May 31, 2016 · d0eb37d · d0eb37d
2 parents 48a1de5 + 3d1f5ba
commit d0eb37d
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 7 deletions.
diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs
@@ -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).
 --

diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs
@@ -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
@@ -1025,13 +1036,18 @@ 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
                                     (pkgRegisterPackageDBStack pkg) ipkg'
-          return ipkgs
+          return ipkgs'
         else return []
 
     --TODO: [required feature] docs and test phases

diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
@@ -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,