projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Obey the -rtsopts flag when making shared libraries; part of #4464
[ghc-hetmet.git]
/
compiler
/
main
/
SysTools.lhs
diff --git
a/compiler/main/SysTools.lhs
b/compiler/main/SysTools.lhs
index
12b73d3
..
fb07875
100644
(file)
--- a/
compiler/main/SysTools.lhs
+++ b/
compiler/main/SysTools.lhs
@@
-45,7
+45,6
@@
import ErrUtils
import Panic
import Util
import DynFlags
import Panic
import Util
import DynFlags
-import FiniteMap
import Exception
import Data.IORef
import Exception
import Data.IORef
@@
-58,6
+57,7
@@
import System.IO.Error as IO
import System.Directory
import Data.Char
import Data.List
import System.Directory
import Data.Char
import Data.List
+import qualified Data.Map as Map
#ifndef mingw32_HOST_OS
import qualified System.Posix.Internals
#ifndef mingw32_HOST_OS
import qualified System.Posix.Internals
@@
-66,7
+66,7
@@
import Foreign
import Foreign.C.String
#endif
import Foreign.C.String
#endif
-import System.Process ( runInteractiveProcess, getProcessExitCode )
+import System.Process
import Control.Concurrent
import FastString
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
import Control.Concurrent
import FastString
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
@@
-472,8
+472,8
@@
cleanTempDirs dflags
= unless (dopt Opt_KeepTmpFiles dflags)
$ do let ref = dirsToClean dflags
ds <- readIORef ref
= unless (dopt Opt_KeepTmpFiles dflags)
$ do let ref = dirsToClean dflags
ds <- readIORef ref
- removeTmpDirs dflags (eltsFM ds)
- writeIORef ref emptyFM
+ removeTmpDirs dflags (Map.elems ds)
+ writeIORef ref Map.empty
cleanTempFiles :: DynFlags -> IO ()
cleanTempFiles dflags
cleanTempFiles :: DynFlags -> IO ()
cleanTempFiles dflags
@@
-515,7
+515,7
@@
getTempDir :: DynFlags -> IO FilePath
getTempDir dflags@(DynFlags{tmpDir=tmp_dir})
= do let ref = dirsToClean dflags
mapping <- readIORef ref
getTempDir dflags@(DynFlags{tmpDir=tmp_dir})
= do let ref = dirsToClean dflags
mapping <- readIORef ref
- case lookupFM mapping tmp_dir of
+ case Map.lookup tmp_dir mapping of
Nothing ->
do x <- getProcessID
let prefix = tmp_dir </> "ghc" ++ show x ++ "_"
Nothing ->
do x <- getProcessID
let prefix = tmp_dir </> "ghc" ++ show x ++ "_"
@@
-524,7
+524,7
@@
getTempDir dflags@(DynFlags{tmpDir=tmp_dir})
mkTempDir x
= let dirname = prefix ++ show x
in do createDirectory dirname
mkTempDir x
= let dirname = prefix ++ show x
in do createDirectory dirname
- let mapping' = addToFM mapping tmp_dir dirname
+ let mapping' = Map.insert tmp_dir dirname mapping
writeIORef ref mapping'
debugTraceMsg dflags 2 (ptext (sLit "Created temporary directory:") <+> text dirname)
return dirname
writeIORef ref mapping'
debugTraceMsg dflags 2 (ptext (sLit "Created temporary directory:") <+> text dirname)
return dirname
@@
-597,7
+597,12
@@
runSomethingFiltered
runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do
let real_args = filter notNull (map showOpt args)
runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do
let real_args = filter notNull (map showOpt args)
- traceCmd dflags phase_name (unwords (pgm:real_args)) $ do
+#if __GLASGOW_HASKELL__ >= 701
+ cmdLine = showCommandForUser pgm real_args
+#else
+ cmdLine = unwords (pgm:real_args)
+#endif
+ traceCmd dflags phase_name cmdLine $ do
(exit_code, doesn'tExist) <-
IO.catch (do
rc <- builderMainLoop dflags filter_fn pgm real_args mb_env
(exit_code, doesn'tExist) <-
IO.catch (do
rc <- builderMainLoop dflags filter_fn pgm real_args mb_env