X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=fb9cf378044cbffd1725ca437cd871020d1016a9;hb=1dc5c28c2370cc8254f024c5734f76d7e5827cd6;hp=a3774276eaebd2cfd50dc0e4d4f4e7ffffdbc3fa;hpb=8a994e17e7502f31ce2d830ace2f00c305619fa3;p=ghc-hetmet.git

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index a377427..fb9cf37 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -615,19 +615,14 @@ removeTmpDirs :: DynFlags -> [FilePath] -> IO ()
 removeTmpDirs dflags ds
   = traceCmd dflags "Deleting temp dirs"
 	     ("Deleting: " ++ unwords ds)
-	     (mapM_ rmdir ds)
-  where
-    rmdir d = removeDirectory d `IO.catch`
-		(\_ignored ->
-		    debugTraceMsg dflags 2 (ptext SLIT("Warning: deleting") <+> text d <+> ptext SLIT("raised exception"))
-		)
+	     (mapM_ (removeWith dflags removeDirectory) ds)
 
 removeTmpFiles :: DynFlags -> [FilePath] -> IO ()
 removeTmpFiles dflags fs
   = warnNon $
     traceCmd dflags "Deleting temp files" 
 	     ("Deleting: " ++ unwords deletees)
-	     (mapM_ rm deletees)
+	     (mapM_ (removeWith dflags removeFile) deletees)
   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
@@ -643,11 +638,16 @@ removeTmpFiles dflags fs
 
     (non_deletees, deletees) = partition isHaskellUserSrcFilename fs
 
-    rm f = removeFile f `IO.catch` 
-		(\_ignored -> 
-		    debugTraceMsg dflags 2 (ptext SLIT("Warning: deleting non-existent") <+> text f)
-		)
-
+removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()
+removeWith dflags remover f = remover f `IO.catch`
+  (\e ->
+   let msg = if isDoesNotExistError e
+             then ptext SLIT("Warning: deleting non-existent") <+> text f
+             else ptext SLIT("Warning: exception raised when deleting")
+                                            <+> text f <> colon
+               $$ text (show e)
+   in debugTraceMsg dflags 2 msg
+  )
 
 -----------------------------------------------------------------------------
 -- Running an external program