[not a darcs patch, context dropped] Sat Jun 6 02:47:20 CEST 2009 Bertram Felgenhauer * Avoid using object files with duplicate names. New patches: [Avoid using object files with duplicate names. Bertram Felgenhauer **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 **20090605143244]