Use kludgedSystem instead of system to work sanely (AFATIP) on Windows.
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.31 2000/12/11 12:15:15 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.32 2000/12/11 12:30:58 rrt Exp $
--
-- Driver flags
--
unless n $ do
-- and run it!
-#ifndef mingw32_TARGET_OS
- exit_code <- system cmd `catchAllIO`
- (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
-#else
- tmp <- newTempName "sh"
- h <- openFile tmp WriteMode
- hPutStrLn h cmd
- hClose h
- exit_code <- system ("sh - " ++ tmp) `catchAllIO`
- (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
- removeFile tmp
-#endif
+ exit_code <- kludgedSystem cmd phase_name
if exit_code /= ExitSuccess
then throwDyn (PhaseFailed phase_name exit_code)
else do when (verb >= 3) (putStr "\n")
return ()
-
-----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.11 2000/11/20 16:28:29 simonmar Exp $
+-- $Id: DriverUtil.hs,v 1.12 2000/12/11 12:30:58 rrt Exp $
--
-- Utils for the driver
--
module DriverUtil where
+#include "../includes/config.h"
#include "HsVersions.h"
import Util
+import TmpFiles ( newTempName )
import IOExts
import Exception
import IO
import System
+import Directory ( removeFile )
import List
import Char
import Monad
remove_spaces :: String -> String
remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+-- system that works feasibly under Windows (i.e. passes the command line to sh,
+-- because system() under Windows doesn't look at SHELL, and always uses CMD.EXE)
+kludgedSystem cmd phase_name
+ = do
+#ifndef mingw32_TARGET_OS
+ exit_code <- system cmd `catchAllIO`
+ (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
+#else
+ tmp <- newTempName "sh"
+ h <- openFile tmp WriteMode
+ hPutStrLn h cmd
+ hClose h
+ exit_code <- system ("sh - " ++ tmp) `catchAllIO`
+ (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
+ removeFile tmp
+#endif
+ return exit_code
-----------------------------------------------------------------------------
--- $Id: PackageMaintenance.hs,v 1.3 2000/10/26 16:21:02 sewardj Exp $
+-- $Id: PackageMaintenance.hs,v 1.4 2000/12/11 12:30:58 rrt Exp $
--
-- GHC Driver program
--
hPutStr stdout "\nWARNING: an error was encountered while the new \n\
\configuration was being written. Attempting to \n\
\restore the old configuration... "
- system ("cp " ++ conf_file ++ ".old " ++ conf_file)
+ kludgedSystem "Restoring old configuration" ("cp " ++ conf_file ++ ".old " ++ conf_file)
hPutStrLn stdout "done."
throw e
)
-- 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...
- system ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old")
+ kludgedSystem "Saving package configuration" ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old")
hPutStrLn stdout "done."
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.11 2000/12/07 08:20:46 simonpj Exp $
+-- $Id: TmpFiles.hs,v 1.12 2000/12/11 12:30:58 rrt Exp $
--
-- Temporary file management
--
-- main
import Config
import Util
+import DriverUtil ( kludgedSystem )
-- hslibs
import Exception
let blowAway f =
(do when verbose (hPutStrLn stderr ("Removing: " ++ f))
- if '*' `elem` f then system ("rm -f " ++ f) >> return ()
+ if '*' `elem` f then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
else removeFile f)
`catchAllIO`
(\_ -> when verbose (hPutStrLn stderr