projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove the no-ghci-lib warning in ghc-pkg
[ghc-hetmet.git]
/
utils
/
ghc-pkg
/
Main.hs
diff --git
a/utils/ghc-pkg/Main.hs
b/utils/ghc-pkg/Main.hs
index
00d3681
..
20a6a44
100644
(file)
--- a/
utils/ghc-pkg/Main.hs
+++ b/
utils/ghc-pkg/Main.hs
@@
-1,4
+1,4
@@
-{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LANGUAGE PatternGuards, CPP, ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 2004-2009.
-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 2004-2009.
@@
-27,8
+27,6
@@
import Text.Printf
import Prelude
import Prelude
-#include "../../includes/ghcconfig.h"
-
import System.Console.GetOpt
import qualified Control.Exception as Exception
import Data.Maybe
import System.Console.GetOpt
import qualified Control.Exception as Exception
import Data.Maybe
@@
-40,7
+38,7
@@
import System.Directory ( doesDirectoryExist, getDirectoryContents,
import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv )
import System.IO
import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv )
import System.IO
-import System.IO.Error (try)
+import System.IO.Error
import Data.List
import Control.Concurrent
import Data.List
import Control.Concurrent
@@
-65,8
+63,6
@@
import GHC.ConsoleHandler
import System.Posix hiding (fdToHandle)
#endif
import System.Posix hiding (fdToHandle)
#endif
-import IO ( isPermissionError )
-
#if defined(GLOB)
import System.Process(runInteractiveCommand)
import qualified System.Info(os)
#if defined(GLOB)
import System.Process(runInteractiveCommand)
import qualified System.Info(os)
@@
-721,7
+717,7
@@
changeDBDir verbosity cmds db = do
do_cmd (RemovePackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ putStrLn ("removing " ++ file)
do_cmd (RemovePackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ putStrLn ("removing " ++ file)
- removeFile file
+ removeFileSafe file
do_cmd (AddPackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ putStrLn ("writing " ++ file)
do_cmd (AddPackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ putStrLn ("writing " ++ file)
@@
-1324,7
+1320,7
@@
checkHSLib dirs auto_ghci_libs lib = do
case m of
Nothing -> verror ForceFiles ("cannot find " ++ batch_lib_file ++
" on library path")
case m of
Nothing -> verror ForceFiles ("cannot find " ++ batch_lib_file ++
" on library path")
- Just dir -> liftIO $ checkGHCiLib dirs dir batch_lib_file lib auto_ghci_libs
+ Just dir -> liftIO $ checkGHCiLib dir batch_lib_file lib auto_ghci_libs
doesFileExistOnPath :: String -> [FilePath] -> IO (Maybe FilePath)
doesFileExistOnPath file path = go path
doesFileExistOnPath :: String -> [FilePath] -> IO (Maybe FilePath)
doesFileExistOnPath file path = go path
@@
-1350,13
+1346,10
@@
checkModules pkg = do
when (isNothing m) $
verror ForceFiles ("file " ++ file ++ " is missing")
when (isNothing m) $
verror ForceFiles ("file " ++ file ++ " is missing")
-checkGHCiLib :: [String] -> String -> String -> String -> Bool -> IO ()
-checkGHCiLib dirs batch_lib_dir batch_lib_file lib auto_build
+checkGHCiLib :: String -> String -> String -> Bool -> IO ()
+checkGHCiLib batch_lib_dir batch_lib_file lib auto_build
| auto_build = autoBuildGHCiLib batch_lib_dir batch_lib_file ghci_lib_file
| auto_build = autoBuildGHCiLib batch_lib_dir batch_lib_file ghci_lib_file
- | otherwise = do
- m <- doesFileExistOnPath ghci_lib_file dirs
- when (isNothing m && ghci_lib_file /= "HSrts.o") $
- warn ("warning: can't find GHCi lib " ++ ghci_lib_file)
+ | otherwise = return ()
where
ghci_lib_file = lib <.> "o"
where
ghci_lib_file = lib <.> "o"
@@
-1586,7
+1579,7
@@
withFileAtomic targetFile write_content = do
`catchIO` \err -> do
exists <- doesFileExist targetFile
if exists
`catchIO` \err -> do
exists <- doesFileExist targetFile
if exists
- then do removeFile targetFile
+ then do removeFileSafe targetFile
-- Big fat hairy race condition
renameFile newFile targetFile
-- If the removeFile succeeds and the renameFile fails
-- Big fat hairy race condition
renameFile newFile targetFile
-- If the removeFile succeeds and the renameFile fails
@@
-1596,7
+1589,7
@@
withFileAtomic targetFile write_content = do
renameFile newFile targetFile
#endif
`Exception.onException` do hClose newHandle
renameFile newFile targetFile
#endif
`Exception.onException` do hClose newHandle
- removeFile newFile
+ removeFileSafe newFile
where
template = targetName <.> "tmp"
targetDir | null targetDir_ = "."
where
template = targetName <.> "tmp"
targetDir | null targetDir_ = "."
@@
-1695,3
+1688,9
@@
readUTF8File file = do
hSetEncoding h utf8
#endif
hGetContents h
hSetEncoding h utf8
#endif
hGetContents h
+
+-- removeFileSave doesn't throw an exceptions, if the file is already deleted
+removeFileSafe :: FilePath -> IO ()
+removeFileSafe fn =
+ removeFile fn `catch` \ e ->
+ when (not $ isDoesNotExistError e) $ ioError e