From: simonmar <unknown>
Date: Fri, 18 Jul 2003 12:47:11 +0000 (+0000)
Subject: [project @ 2003-07-18 12:47:11 by simonmar]
X-Git-Tag: Approx_11550_changesets_converted~683
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=37ad132b596204ce913a4c72905d6d06e32c0970

[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).
---

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index 576761b..dfaa2eb 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -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