Show full ABI hash for installed packages in solver log (fixes haskel…

…l#5892). This commit is the same as 96c3bf9, but with the unit tests updated to fix haskell#6495. The tests check less of the solver output so that they are less fragile.
grayjay · Jan 21, 2020 · 4660e90 · 4660e90
1 parent 2a7304b
commit 4660e90
Show file tree

Hide file tree

Showing 4 changed files with 23 additions and 14 deletions.
diff --git a/cabal-install/Distribution/Solver/Modular/Package.hs b/cabal-install/Distribution/Solver/Modular/Package.hs
@@ -18,7 +18,8 @@ module Distribution.Solver.Modular.Package
   , unPN
   ) where
 
-import Data.List as L
+import Prelude ()
+import Distribution.Solver.Compat.Prelude
 
 import Distribution.Package -- from Cabal
 import Distribution.Deprecated.Text (display)
@@ -57,14 +58,12 @@ data I = I Ver Loc
 -- | String representation of an instance.
 showI :: I -> String
 showI (I v InRepo)   = showVer v
-showI (I v (Inst uid)) = showVer v ++ "/installed" ++ shortId uid
+showI (I v (Inst uid)) = showVer v ++ "/installed" ++ extractPackageAbiHash uid
   where
-    -- A hack to extract the beginning of the package ABI hash
-    shortId = snip (splitAt 4) (++ "...")
-            . snip ((\ (x, y) -> (reverse x, y)) . break (=='-') . reverse) ('-':)
-            . display
-    snip p f xs = case p xs of
-                    (ys, zs) -> (if L.null zs then id else f) ys
+    extractPackageAbiHash xs =
+      case first reverse $ break (=='-') $ reverse (display xs) of
+        (ys, []) -> ys
+        (ys, _)  -> '-' : ys
 
 -- | Package instance. A package name and an instance.
 data PI qpn = PI qpn I

diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs
@@ -708,6 +708,18 @@ tests = [
               "minimize conflict set with --minimize-conflict-set"
         , testNoMinimizeConflictSet
               "show original conflict set with --no-minimize-conflict-set"
+        , runTest $
+              let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
+                       , Left $ exInst "other-package" 2 "other-package-2.0.0" []]
+                  msg = "rejecting: other-package-2.0.0/installed-2.0.0"
+              in mkTest db "show full installed package version (issue #5892)" ["my-package"] $
+                 solverFailure (isInfixOf msg)
+        , runTest $
+              let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
+                       , Left $ exInst "other-package" 2 "other-package-AbCdEfGhIj0123456789" [] ]
+                  msg = "rejecting: other-package-2.0.0/installed-AbCdEfGhIj0123456789"
+              in mkTest db "show full installed package ABI hash (issue #5892)" ["my-package"] $
+                 solverFailure (isInfixOf msg)
         ]
     ]
   where

diff --git a/cabal-testsuite/PackageTests/Backpack/Includes2/setup-external.cabal.out b/cabal-testsuite/PackageTests/Backpack/Includes2/setup-external.cabal.out
@@ -101,7 +101,7 @@ Warning: solver failed to find a solution:
 Could not resolve dependencies:
 [__0] trying: exe-0.1.0.0 (user goal)
 [__1] next goal: src (dependency of exe)
-[__1] rejecting: src-<VERSION>/installed-<HASH>... (conflict: src => mylib==0.1.0.0/installed-0.1..., src => mylib==0.1.0.0/installed-0.1...)
+[__1] rejecting: src-<VERSION>/installed-<HASH> (conflict: src => mylib==<VERSION>/installed-<HASH>, src => mylib==<VERSION>/installed-<HASH>)
 [__1] fail (backjumping, conflict set: exe, src)
 After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: exe (2), src (2)
 Trying configure anyway.

diff --git a/cabal-testsuite/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/Test/Cabal/OutputNormalizer.hs
@@ -33,13 +33,11 @@ normalizeOutput nenv =
   . resub (posixRegexEscape (normalizerRoot nenv)) "<ROOT>/"
   . resub (posixRegexEscape (normalizerTmpDir nenv)) "<TMPDIR>/"
   . appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv)))
-    -- Look for foo-0.1/installed-0d6...
+    -- Look for 0.1/installed-0d6uzW7Ubh1Fb4TB5oeQ3G
     -- These installed packages will vary depending on GHC version
-    -- Makes assumption that installed packages don't have numbers
-    -- in package name segment.
     -- Apply this before packageIdRegex, otherwise this regex doesn't match.
-  . resub "([a-zA-Z]+(-[a-zA-Z])*)-[0-9]+(\\.[0-9]+)*/installed-[A-Za-z0-9.]+"
-          "\\1-<VERSION>/installed-<HASH>..."
+  . resub "[0-9]+(\\.[0-9]+)*/installed-[A-Za-z0-9.+]+"
+          "<VERSION>/installed-<HASH>"
     -- Normalize architecture
   . resub (posixRegexEscape (display (normalizerPlatform nenv))) "<ARCH>"
     -- Some GHC versions are chattier than others