aboutsummaryrefslogtreecommitdiffstats
path: root/community/ghc/0004-reproducible-tmp-names.patch
diff options
context:
space:
mode:
Diffstat (limited to 'community/ghc/0004-reproducible-tmp-names.patch')
-rw-r--r--community/ghc/0004-reproducible-tmp-names.patch43
1 files changed, 43 insertions, 0 deletions
diff --git a/community/ghc/0004-reproducible-tmp-names.patch b/community/ghc/0004-reproducible-tmp-names.patch
new file mode 100644
index 0000000000..a0417f145d
--- /dev/null
+++ b/community/ghc/0004-reproducible-tmp-names.patch
@@ -0,0 +1,43 @@
+This is an attempt to make GHC build reproducible. The name of .c files may end
+up in the resulting binary (in the debug section), but not the directory.
+
+Instead of using the process id, create a hash from the command line arguments,
+and assume that is going to be unique.
+
+Index: ghc/compiler/main/SysTools.hs
+===================================================================
+--- ghc.orig/compiler/main/SysTools.hs 2016-04-23 17:57:12.812255430 +0200
++++ ghc/compiler/main/SysTools.hs 2016-04-23 17:57:12.808255337 +0200
+@@ -65,6 +65,7 @@
+ import Util
+ import DynFlags
+ import Exception
++import Fingerprint
+
+ import LlvmCodeGen.Base (llvmVersionStr, supportedLlvmVersion)
+
+@@ -1158,8 +1159,8 @@
+ mapping <- readIORef dir_ref
+ case Map.lookup tmp_dir mapping of
+ Nothing -> do
+- pid <- getProcessID
+- let prefix = tmp_dir </> "ghc" ++ show pid ++ "_"
++ pid <- getStableProcessID
++ let prefix = tmp_dir </> "ghc" ++ pid ++ "_"
+ mask_ $ mkTempDir prefix
+ Just dir -> return dir
+ where
+@@ -1575,6 +1576,13 @@
+ getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
+ #endif
+
++-- Debian-specific hack to get reproducible output, by not using the "random"
++-- pid, but rather something determinisic
++getStableProcessID :: IO String
++getStableProcessID = do
++ args <- getArgs
++ return $ take 4 $ show $ fingerprintString $ unwords args
++
+ -- Divvy up text stream into lines, taking platform dependent
+ -- line termination into account.
+ linesPlatform :: String -> [String]