Commit 80ce44f7 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Always pay attention to -keep-tmp-files when we want to delete files

parent 5b910663
...@@ -339,9 +339,8 @@ defaultErrorHandler dflags inner = ...@@ -339,9 +339,8 @@ defaultErrorHandler dflags inner =
defaultCleanupHandler :: DynFlags -> IO a -> IO a defaultCleanupHandler :: DynFlags -> IO a -> IO a
defaultCleanupHandler dflags inner = defaultCleanupHandler dflags inner =
-- make sure we clean up after ourselves -- make sure we clean up after ourselves
later (unless (dopt Opt_KeepTmpFiles dflags) $ later (do cleanTempFiles dflags
do cleanTempFiles dflags cleanTempDirs dflags
cleanTempDirs dflags
) )
-- exceptions will be blocked while we clean the temporary files, -- exceptions will be blocked while we clean the temporary files,
-- so there shouldn't be any difficulty if we receive further -- so there shouldn't be any difficulty if we receive further
......
...@@ -494,22 +494,25 @@ GLOBAL_VAR(v_DirsToClean, emptyFM, FiniteMap FilePath FilePath ) ...@@ -494,22 +494,25 @@ GLOBAL_VAR(v_DirsToClean, emptyFM, FiniteMap FilePath FilePath )
\begin{code} \begin{code}
cleanTempDirs :: DynFlags -> IO () cleanTempDirs :: DynFlags -> IO ()
cleanTempDirs dflags cleanTempDirs dflags
= do ds <- readIORef v_DirsToClean = unless (dopt Opt_KeepTmpFiles dflags)
$ do ds <- readIORef v_DirsToClean
removeTmpDirs dflags (eltsFM ds) removeTmpDirs dflags (eltsFM ds)
writeIORef v_DirsToClean emptyFM writeIORef v_DirsToClean emptyFM
cleanTempFiles :: DynFlags -> IO () cleanTempFiles :: DynFlags -> IO ()
cleanTempFiles dflags cleanTempFiles dflags
= do fs <- readIORef v_FilesToClean = unless (dopt Opt_KeepTmpFiles dflags)
removeTmpFiles dflags fs $ do fs <- readIORef v_FilesToClean
writeIORef v_FilesToClean [] removeTmpFiles dflags fs
writeIORef v_FilesToClean []
cleanTempFilesExcept :: DynFlags -> [FilePath] -> IO () cleanTempFilesExcept :: DynFlags -> [FilePath] -> IO ()
cleanTempFilesExcept dflags dont_delete cleanTempFilesExcept dflags dont_delete
= do files <- readIORef v_FilesToClean = unless (dopt Opt_KeepTmpFiles dflags)
let (to_keep, to_delete) = partition (`elem` dont_delete) files $ do files <- readIORef v_FilesToClean
removeTmpFiles dflags to_delete let (to_keep, to_delete) = partition (`elem` dont_delete) files
writeIORef v_FilesToClean to_keep removeTmpFiles dflags to_delete
writeIORef v_FilesToClean to_keep
-- find a temporary name that doesn't already exist. -- find a temporary name that doesn't already exist.
......
Markdown is supported
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