[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