hpastetwo

New Revision

[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]

author title

language channel