Commit 37ad132b authored by simonmar's avatar simonmar
Browse files

[project @ 2003-07-18 12:47:11 by simonmar]

Fix a blatant bug in cleanTempFilesExcept, which was causing
legitimate source files to be deleted.  The previous fixes for this
bug missed the real cause of the problem.

I take full blame for this bug, which has been here since the dawn of
GHCi (at least I traced it back to 5.00).
parent 6677029a
......@@ -65,7 +65,6 @@ module SysTools (
#include "HsVersions.h"
import DriverUtil
import DriverPhases ( haskellish_user_src_file )
import Config
import Outputable
import Panic ( progName, GhcException(..) )
......@@ -651,15 +650,17 @@ setTmpDir dir = writeIORef v_TmpDir (canonicalise dir)
#endif
cleanTempFiles :: Int -> IO ()
cleanTempFiles verb = do fs <- readIORef v_FilesToClean
removeTmpFiles verb fs
cleanTempFiles verb
= do fs <- readIORef v_FilesToClean
removeTmpFiles verb fs
writeIORef v_FilesToClean []
cleanTempFilesExcept :: Int -> [FilePath] -> IO ()
cleanTempFilesExcept verb dont_delete
= do fs <- readIORef v_FilesToClean
let leftovers = filter (`notElem` dont_delete) fs
removeTmpFiles verb leftovers
writeIORef v_FilesToClean dont_delete
= do files <- readIORef v_FilesToClean
let (to_keep, to_delete) = partition (`elem` dont_delete) files
removeTmpFiles verb to_delete
writeIORef v_FilesToClean to_keep
-- find a temporary name that doesn't already exist.
......@@ -682,25 +683,10 @@ addFilesToClean files = mapM_ (add v_FilesToClean) files
removeTmpFiles :: Int -> [FilePath] -> IO ()
removeTmpFiles verb fs
= warnNon $
traceCmd "Deleting temp files"
("Deleting: " ++ unwords deletees)
(mapM_ rm deletees)
= traceCmd "Deleting temp files"
("Deleting: " ++ unwords fs)
(mapM_ rm fs)
where
-- Flat out refuse to delete files that are likely to be source input
-- files (is there a worse bug than having a compiler delete your source
-- files?)
--
-- Deleting source files is a sign of a bug elsewhere, so prominently flag
-- the condition.
warnNon act
| null non_deletees = act
| otherwise = do
hPutStrLn stderr ("WARNING - NOT deleting source files: " ++ unwords non_deletees)
act
(non_deletees, deletees) = partition haskellish_user_src_file fs
rm f = removeFile f `IO.catch`
(\_ignored ->
when (verb >= 2) $
......@@ -833,8 +819,12 @@ interpreted a command line 'foo\baz' as 'foobaz'.
-----------------------------------------------------------------------------
-- Convert filepath into platform / MSDOS form.
-- platformPath does two things
-- a) change '/' to '\'
-- b) remove initial '/cygdrive/'
normalisePath :: String -> String
-- Just changes '\' to '/'
-- Just change '\' to '/'
pgmPath :: String -- Directory string in Unix format
-> String -- Program name with no directory separators
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment