From: sof <unknown>
Date: Wed, 10 Oct 2001 23:17:14 +0000 (+0000)
Subject: [project @ 2001-10-10 23:17:14 by sof]
X-Git-Tag: Approximately_9120_patches~851
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3f1b7ac446f759d5e6a3a1f0b7e8ba6b2912531e;p=ghc-hetmet.git

[project @ 2001-10-10 23:17:14 by sof]
savePackageConfig: Robustified - remove existing .old file before saving
away new. In case of failure, print out a msg detailing what files were
involved.
---

diff --git a/ghc/utils/ghc-pkg/Main.hs b/ghc/utils/ghc-pkg/Main.hs
index 6003000..a4cb60c 100644
--- a/ghc/utils/ghc-pkg/Main.hs
+++ b/ghc/utils/ghc-pkg/Main.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.16 2001/09/18 11:07:58 simonmar Exp $
+-- $Id: Main.hs,v 1.17 2001/10/10 23:17:14 sof Exp $
 --
 -- Package management tool
 -----------------------------------------------------------------------------
@@ -176,7 +176,17 @@ savePackageConfig conf_file = do
     -- mv rather than cp because we've already done an hGetContents
     -- on this file so we won't be able to open it for writing
     -- unless we move the old one out of the way...
-  renameFile conf_file (conf_file ++ ".old") 
+  let oldFile = conf_file ++ ".old"
+  doesExist <- doesFileExist oldFile  `catch` (\ _ -> return False)
+  when doesExist (removeFile oldFile `catch` (const $ return ()))
+  catch (renameFile conf_file oldFile)
+  	(\ err -> do
+		hPutStrLn stderr (unwords [ "Unable to rename"
+					  , show conf_file
+					  , " to "
+					  , show oldFile
+					  ])
+		ioError err)
   hPutStrLn stdout "done."
 
 -----------------------------------------------------------------------------