projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2001-02-07 12:54:09 by sewardj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
main
/
TmpFiles.hs
diff --git
a/ghc/compiler/main/TmpFiles.hs
b/ghc/compiler/main/TmpFiles.hs
index
310c747
..
5bd5e59
100644
(file)
--- a/
ghc/compiler/main/TmpFiles.hs
+++ b/
ghc/compiler/main/TmpFiles.hs
@@
-1,5
+1,5
@@
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.3 2000/10/23 09:03:27 simonpj Exp $
+-- $Id: TmpFiles.hs,v 1.14 2000/12/11 15:26:00 sewardj Exp $
--
-- Temporary file management
--
--
-- Temporary file management
--
@@
-12,16
+12,16
@@
module TmpFiles (
initTempFileStorage, -- :: IO ()
cleanTempFiles, -- :: IO ()
newTempName, -- :: Suffix -> IO FilePath
initTempFileStorage, -- :: IO ()
cleanTempFiles, -- :: IO ()
newTempName, -- :: Suffix -> IO FilePath
- addFilesToClean -- :: [FilePath] -> IO ()
+ addFilesToClean, -- :: [FilePath] -> IO ()
+ v_TmpDir
) where
-- main
) where
-- main
-import DriverState
import Config
import Util
import Config
import Util
+import DriverUtil
-- hslibs
-- hslibs
--- import Posix commented out SLPJ
import Exception
import IOExts
import Exception
import IOExts
@@
-34,24
+34,29
@@
import Monad
#include "HsVersions.h"
GLOBAL_VAR(v_FilesToClean, [], [String] )
#include "HsVersions.h"
GLOBAL_VAR(v_FilesToClean, [], [String] )
+GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String )
+
initTempFileStorage = do
-- check whether TMPDIR is set in the environment
IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
initTempFileStorage = do
-- check whether TMPDIR is set in the environment
IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
- writeIORef v_TmpDir dir)
-
+#ifndef mingw32_TARGET_OS
+ writeIORef v_TmpDir dir
+#endif
+ return ()
+ )
cleanTempFiles :: Bool -> IO ()
cleanTempFiles verbose = do
fs <- readIORef v_FilesToClean
let blowAway f =
cleanTempFiles :: Bool -> IO ()
cleanTempFiles verbose = do
fs <- readIORef v_FilesToClean
let blowAway f =
- (do when verbose (hPutStrLn stderr ("removing: " ++ f))
- if '*' `elem` f then system ("rm -f " ++ f) >> return ()
+ (do when verbose (hPutStrLn stderr ("Removing: " ++ f))
+ if '*' `elem` f then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
else removeFile f)
`catchAllIO`
(\_ -> when verbose (hPutStrLn stderr
else removeFile f)
`catchAllIO`
(\_ -> when verbose (hPutStrLn stderr
- ("warning: can't remove tmp file" ++ f)))
+ ("Warning: can't remove tmp file " ++ f)))
mapM_ blowAway fs
type Suffix = String
mapM_ blowAway fs
type Suffix = String
@@
-59,7
+64,7
@@
type Suffix = String
-- find a temporary name that doesn't already exist.
newTempName :: Suffix -> IO FilePath
newTempName extn = do
-- find a temporary name that doesn't already exist.
newTempName :: Suffix -> IO FilePath
newTempName extn = do
- x <- getProcessID
+ x <- myGetProcessID
tmp_dir <- readIORef v_TmpDir
findTempName tmp_dir x
where findTempName tmp_dir x = do
tmp_dir <- readIORef v_TmpDir
findTempName tmp_dir x
where findTempName tmp_dir x = do
@@
-71,9
+76,3
@@
newTempName extn = do
addFilesToClean :: [FilePath] -> IO ()
addFilesToClean files = mapM_ (add v_FilesToClean) files
addFilesToClean :: [FilePath] -> IO ()
addFilesToClean files = mapM_ (add v_FilesToClean) files
-
-add :: IORef [a] -> a -> IO ()
-add var x = do
- xs <- readIORef var
- writeIORef var (x:xs)
-