Skip to content
Snippets Groups Projects
Commit dd19cfa0 authored by Rodrigo Mesquita's avatar Rodrigo Mesquita :seedling: Committed by Mikolaj
Browse files

Include the compiler ABI hash in the package hash

This complements the previous commit in order to fix #9326
parent b055abb5
No related branches found
No related tags found
No related merge requests found
......@@ -82,7 +82,7 @@ module Distribution.Simple.GHC
import Distribution.Compat.Prelude
import Prelude ()
import Control.Monad (forM_, msum)
import Control.Monad (forM_)
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Distribution.CabalSpecVersion
......
......@@ -10,6 +10,8 @@
-- * the package tarball
-- * the ids of all the direct dependencies
-- * other local configuration (flags, profiling, etc)
--
-- See 'PackageHashInputs' for a detailed list of what determines the hash.
module Distribution.Client.PackageHash
( -- * Calculating package hashes
PackageHashInputs (..)
......@@ -38,7 +40,8 @@ import Distribution.Package
, mkComponentId
)
import Distribution.Simple.Compiler
( CompilerId
( AbiTag (..)
, CompilerId
, DebugInfoLevel (..)
, OptimisationLevel (..)
, PackageDB
......@@ -191,6 +194,7 @@ type PackageSourceHash = HashValue
-- package hash.
data PackageHashConfigInputs = PackageHashConfigInputs
{ pkgHashCompilerId :: CompilerId
, pkgHashCompilerABI :: AbiTag
, pkgHashPlatform :: Platform
, pkgHashFlagAssignment :: FlagAssignment -- complete not partial
, pkgHashConfigureScriptArgs :: [String] -- just ./configure for build-type Configure
......@@ -301,6 +305,7 @@ renderPackageHashInputs
pkgHashDirectDeps
, -- and then all the config
entry "compilerid" prettyShow pkgHashCompilerId
, entry "compilerabi" prettyShow pkgHashCompilerABI
, entry "platform" prettyShow pkgHashPlatform
, opt "flags" mempty showFlagAssignment pkgHashFlagAssignment
, opt "configure-script" [] unwords pkgHashConfigureScriptArgs
......
......@@ -71,7 +71,6 @@ import Distribution.Simple.BuildPaths (haddockDirName)
import Distribution.Simple.Command (CommandUI)
import Distribution.Simple.Compiler
( PackageDBStack
, compilerId
)
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
......
......@@ -4303,6 +4303,7 @@ packageHashConfigInputs
packageHashConfigInputs shared@ElaboratedSharedConfig{..} pkg =
PackageHashConfigInputs
{ pkgHashCompilerId = compilerId pkgConfigCompiler
, pkgHashCompilerABI = compilerAbiTag pkgConfigCompiler
, pkgHashPlatform = pkgConfigPlatform
, pkgHashFlagAssignment = elabFlagAssignment
, pkgHashConfigureScriptArgs = elabConfigureScriptArgs
......
......@@ -63,7 +63,7 @@ import Test.Cabal.TestCode
import Distribution.Pretty (prettyShow)
import Distribution.Simple.Compiler
( PackageDBStack, PackageDB(..), compilerFlavor
, Compiler, compilerVersion, showCompilerId )
, Compiler, compilerVersion, showCompilerIdWithAbi )
import Distribution.System
import Distribution.Simple.Program.Db
import Distribution.Simple.Program
......@@ -582,7 +582,7 @@ testLibInstallDir env = libDir </> compilerDir
libDir = case os of
Windows -> testPrefixDir env
_ -> testPrefixDir env </> "lib"
compilerDir = prettyShow platform ++ "-" ++ showCompilerId (testCompiler env)
compilerDir = prettyShow platform ++ "-" ++ showCompilerIdWithAbi (testCompiler env)
-- | The absolute path to the build directory that should be used
-- for the current package in a test.
......
......@@ -58,7 +58,9 @@ normalizeOutput nenv =
. (if normalizerGhcVersion nenv /= nullVersion
then resub (posixRegexEscape (display (normalizerGhcVersion nenv))
-- Also glob the date, for nightly GHC builds
++ "(\\.[0-9]+)?")
++ "(\\.[0-9]+)?"
-- Also glob the ABI hash, for GHCs which support it
++ "(-[a-z0-9]+)?")
"<GHCVER>"
else id)
-- hackage-security locks occur non-deterministically
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment