1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103 | [not a darcs patch, context dropped]
Sat Jun 6 02:47:20 CEST 2009 Bertram Felgenhauer <int-e@gmx.de>
* Avoid using object files with duplicate names.
New patches:
[Avoid using object files with duplicate names.
Bertram Felgenhauer <int-e@gmx.de>**20090606004720] {
hunk ./Distribution/Simple/GHC.hs 115
( display, simpleParse )
import Language.Haskell.Extension (Extension(..))
+import qualified Data.Set as Set
import Control.Monad ( unless, when )
import Data.Char
import Data.List
hunk ./Distribution/Simple/GHC.hs 123
import System.Directory ( removeFile, renameFile,
getDirectoryContents, doesFileExist,
getTemporaryDirectory )
-import System.FilePath ( (</>), (<.>), takeExtension,
+import System.FilePath ( (</>), (<.>), takeExtension, takeBaseName,
takeDirectory, replaceExtension, splitExtension )
import System.IO (hClose, hPutStrLn)
import Distribution.Compat.Exception (catchExit, catchIO)
hunk ./Distribution/Simple/GHC.hs 537
(ModuleName.toFilePath x ++"_stub")
| x <- libModules lib ]
- hObjs <- getHaskellObjects lib lbi
+ hObjs <- getHaskellObjects verbosity lib lbi
pref objExtension True
hProfObjs <-
if (withProfLib lbi)
hunk ./Distribution/Simple/GHC.hs 541
- then getHaskellObjects lib lbi
+ then getHaskellObjects verbosity lib lbi
pref ("p_" ++ objExtension) True
else return []
hSharedObjs <-
hunk ./Distribution/Simple/GHC.hs 546
if (withSharedLib lbi)
- then getHaskellObjects lib lbi
+ then getHaskellObjects verbosity lib lbi
pref ("dyn_" ++ objExtension) False
else return []
hunk ./Distribution/Simple/GHC.hs 707
-- when using -split-objs, we need to search for object files in the
-- Module_split directory for each module.
-getHaskellObjects :: Library -> LocalBuildInfo
+getHaskellObjects :: Verbosity -> Library -> LocalBuildInfo
-> FilePath -> String -> Bool -> IO [FilePath]
hunk ./Distribution/Simple/GHC.hs 709
-getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs
+getHaskellObjects verbosity lib lbi pref wanted_obj_ext allow_split_objs
| splitObjs lbi && allow_split_objs = do
let dirs = [ pref </> (ModuleName.toFilePath x ++ "_split")
| x <- libModules lib ]
hunk ./Distribution/Simple/GHC.hs 718
| (objs',dir) <- zip objss dirs, obj <- objs',
let obj_ext = takeExtension obj,
'.':wanted_obj_ext == obj_ext ]
- return objs
+ makeUniqueObjects verbosity pref objs
| otherwise =
hunk ./Distribution/Simple/GHC.hs 720
- return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
+ makeUniqueObjects verbosity pref
+ [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
| x <- libModules lib ]
hunk ./Distribution/Simple/GHC.hs 724
+-- cf. #318: Avoid using object files with duplicate names.
+makeUniqueObjects :: Verbosity -> FilePath -> [FilePath] -> IO [FilePath]
+makeUniqueObjects verbosity pref fps = go Set.empty fps [] where
+ dir = pref </> "extra_objects"
+
+ go _ [] fps' = return fps'
+ go s (fp:fps) fps' = do
+ let bn = takeBaseName fp
+ if bn `Set.notMember` s then
+ go (bn `Set.insert` s) fps (fp:fps')
+ else do
+ let bn' = head [bn' | n <- [0..],
+ let bn' = show n ++ bn,
+ bn' `Set.notMember` s]
+ fp' = dir </> fp'
+ createDirectoryIfMissingVerbose verbosity False dir
+ copyFileVerbose verbosity fp fp'
+ go (bn' `Set.insert` s) fps (fp':fps')
constructGHCCmdLine
:: LocalBuildInfo
}
Context:
[Pass a verbosity flag to ghc-pkg
Ian Lynagh <igloo@earth.li>**20090605143244]
|