[commit: packages/Cabal] ghc-head: Use 'dist-sandbox-$SANDBOX_DIR_HASH' as the build dir for add-source deps. (cf724a1)
git at git.haskell.org
git at git.haskell.org
Mon Aug 26 23:24:44 CEST 2013
Repository : ssh://git@git.haskell.org/Cabal
On branch : ghc-head
Link : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=cf724a1f0252bef2d956284b3a2b6e6c904c2fe5
>---------------------------------------------------------------
commit cf724a1f0252bef2d956284b3a2b6e6c904c2fe5
Author: Mikhail Glushenkov <mikhail.glushenkov at gmail.com>
Date: Tue May 7 00:13:47 2013 +0200
Use 'dist-sandbox-$SANDBOX_DIR_HASH' as the build dir for add-source deps.
This avoids the risk of conflicts if we use a single add-source dep with
multiple sandboxes.
>---------------------------------------------------------------
cf724a1f0252bef2d956284b3a2b6e6c904c2fe5
cabal-install/Distribution/Client/Sandbox.hs | 33 ++++++++++++++++++++++----
cabal-install/Main.hs | 16 +++++--------
2 files changed, 35 insertions(+), 14 deletions(-)
diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs
index 9b3bcd8..ae18b62 100644
--- a/cabal-install/Distribution/Client/Sandbox.hs
+++ b/cabal-install/Distribution/Client/Sandbox.hs
@@ -89,9 +89,13 @@ import qualified Distribution.Client.Sandbox.Index as Index
import qualified Distribution.Simple.Register as Register
import Control.Exception ( assert, bracket_ )
import Control.Monad ( forM, liftM2, unless, when )
+import Data.Bits ( shiftL, shiftR, xor )
+import Data.Char ( ord )
import Data.IORef ( newIORef, writeIORef, readIORef )
-import Data.List ( (\\), delete )
+import Data.List ( (\\), delete, foldl' )
import Data.Monoid ( mempty, mappend )
+import Data.Word ( Word32 )
+import Numeric ( showHex )
import System.Directory ( createDirectory
, doesDirectoryExist
, doesFileExist
@@ -114,8 +118,29 @@ snapshotDirectoryName = "snapshots"
-- | Non-standard build dir that is used for building add-source deps instead of
-- "dist". Fixes surprising behaviour in some cases (see issue #1281).
-sandboxBuildDir :: FilePath
-sandboxBuildDir = "dist/sandbox-dist"
+sandboxBuildDir :: FilePath -> FilePath
+sandboxBuildDir sandboxDir = "dist/dist-sandbox-" ++ showHex sandboxDirHash ""
+ where
+ sandboxDirHash = jenkins sandboxDir
+
+ -- See http://en.wikipedia.org/wiki/Jenkins_hash_function
+ jenkins :: String -> Word32
+ jenkins str = loop_finish $ foldl' loop 0 str
+ where
+ loop :: Word32 -> Char -> Word32
+ loop hash key_i' = hash'''
+ where
+ key_i = toEnum . ord $ key_i'
+ hash' = hash + key_i
+ hash'' = hash' + (shiftL hash' 10)
+ hash''' = hash'' `xor` (shiftR hash'' 6)
+
+ loop_finish :: Word32 -> Word32
+ loop_finish hash = hash'''
+ where
+ hash' = hash + (shiftL hash 3)
+ hash'' = hash' `xor` (shiftR hash' 11)
+ hash''' = hash'' + (shiftL hash'' 15)
--
-- * Basic sandbox functions.
@@ -449,7 +474,7 @@ reinstallAddSourceDeps :: Verbosity
reinstallAddSourceDeps verbosity config configFlags' configExFlags
installFlags globalFlags sandboxDir = do
let configFlags = configFlags'
- { configDistPref = Flag sandboxBuildDir }
+ { configDistPref = Flag (sandboxBuildDir sandboxDir) }
indexFile <- tryGetIndexFilePath config
buildTreeRefs <- Index.listBuildTreeRefs verbosity
Index.DontListIgnored indexFile
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 7be7bdb..b74171d 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -75,7 +75,7 @@ import Distribution.Client.Sandbox (sandboxInit
,dumpPackageEnvironment
,UseSandbox(..)
- ,isUseSandbox, whenUsingSandbox
+ ,whenUsingSandbox
,ForceGlobalInstall(..)
,maybeForceGlobalInstall
,loadConfigOrSandboxConfig
@@ -459,12 +459,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
(configUserInstall configFlags)
targets <- readUserTargets verbosity extraArgs
- let configFlags' =
- let flags = savedConfigureFlags config `mappend` configFlags
- in if isUseSandbox useSandbox
- then flags {configDistPref = Flag sandboxBuildDir }
- else flags
-
+ let configFlags' = savedConfigureFlags config `mappend` configFlags
configExFlags' = defaultConfigExFlags `mappend`
savedConfigureExFlags config `mappend` configExFlags
installFlags' = defaultInstallFlags `mappend`
@@ -477,9 +472,10 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
-- timestamp record for this compiler to the timestamp file.
configFlags'' <- case useSandbox of
NoSandbox -> configAbsolutePaths $ configFlags'
- (UseSandbox sandboxDir) -> return $
- setPackageDB sandboxDir
- comp platform configFlags'
+ (UseSandbox sandboxDir) ->
+ return $ (setPackageDB sandboxDir comp platform configFlags') {
+ configDistPref = Flag (sandboxBuildDir sandboxDir)
+ }
whenUsingSandbox useSandbox $ \sandboxDir -> do
initPackageDBIfNeeded verbosity configFlags'' comp conf
More information about the ghc-commits
mailing list