Commit 68de0081 authored by simonmar's avatar simonmar

[project @ 2001-03-08 09:50:18 by simonmar]

rearrange slightly to make this compile again.
parent 09ff3477
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.46 2001/03/05 10:05:58 simonmar Exp $
-- $Id: DriverFlags.hs,v 1.47 2001/03/08 09:50:18 simonmar Exp $
--
-- Driver flags
--
......@@ -23,7 +23,7 @@ module DriverFlags (
import PackageMaintenance
import DriverState
import DriverUtil
import TmpFiles ( v_TmpDir )
import TmpFiles ( v_TmpDir, kludgedSystem )
import CmdLineOpts
import Config
import Util
......
-----------------------------------------------------------------------------
-- $Id: DriverUtil.hs,v 1.18 2001/03/07 10:28:40 rrt Exp $
-- $Id: DriverUtil.hs,v 1.19 2001/03/08 09:50:18 simonmar Exp $
--
-- Utils for the driver
--
......@@ -14,7 +14,6 @@ module DriverUtil where
import Util
import Panic
import TmpFiles ( v_TmpDir )
import IOExts
import Exception
......@@ -23,7 +22,6 @@ import RegexString
import IO
import System
import Directory ( removeFile )
import List
import Char
import Monad
......@@ -162,24 +160,3 @@ newdir dir s = dir ++ '/':drop_longest_prefix s '/'
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
pid <- myGetProcessID
tmp_dir <- readIORef v_TmpDir
let tmp = tmp_dir++"/sh"++show pid
h <- openFile tmp WriteMode
hPutStrLn h cmd
hClose h
exit_code <- system ("sh - " ++ tmp) `catchAllIO`
(\_ -> removeFile tmp >>
throwDyn (PhaseFailed phase_name (ExitFailure 1)))
removeFile tmp
#endif
return exit_code
-----------------------------------------------------------------------------
-- $Id: PackageMaintenance.hs,v 1.7 2001/03/06 11:23:46 simonmar Exp $
-- $Id: PackageMaintenance.hs,v 1.8 2001/03/08 09:50:18 simonmar Exp $
--
-- GHC Driver program
--
......@@ -14,6 +14,7 @@ module PackageMaintenance
import CmStaticInfo
import DriverState
import DriverUtil
import DriverFlags ( runSomething )
import Panic
import Exception
......@@ -83,7 +84,7 @@ maybeRestoreOldConfig conf_file io
hPutStr stdout "\nWARNING: an error was encountered while the new \n\
\configuration was being written. Attempting to \n\
\restore the old configuration... "
kludgedSystem ("cp " ++ conf_file ++ ".old " ++ conf_file) "Restoring old configuration"
runSomething ("cp " ++ conf_file ++ ".old " ++ conf_file) "Restoring old configuration"
hPutStrLn stdout "done."
throw e
)
......@@ -103,7 +104,7 @@ 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...
kludgedSystem ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") "Saving package configuration"
runSomething ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") "Saving package configuration"
hPutStrLn stdout "done."
-----------------------------------------------------------------------------
......
-----------------------------------------------------------------------------
-- $Id: TmpFiles.hs,v 1.15 2001/02/12 13:33:47 simonmar Exp $
-- $Id: TmpFiles.hs,v 1.16 2001/03/08 09:50:18 simonmar Exp $
--
-- Temporary file management
--
......@@ -15,13 +15,15 @@ module TmpFiles (
newTempName, -- :: Suffix -> IO FilePath
addFilesToClean, -- :: [FilePath] -> IO ()
removeTmpFiles, -- :: Int -> [FilePath] -> IO ()
v_TmpDir
v_TmpDir,
kludgedSystem
) where
-- main
import DriverUtil
import Config
import Panic
import Util
import DriverUtil
-- hslibs
import Exception
......@@ -90,3 +92,25 @@ removeTmpFiles verb fs = do
(\_ -> when verbose (hPutStrLn stderr
("Warning: can't remove tmp file " ++ f)))
mapM_ blowAway fs
-- 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
pid <- myGetProcessID
tmp_dir <- readIORef v_TmpDir
let tmp = tmp_dir++"/sh"++show pid
h <- openFile tmp WriteMode
hPutStrLn h cmd
hClose h
exit_code <- system ("sh - " ++ tmp) `catchAllIO`
(\_ -> removeFile tmp >>
throwDyn (PhaseFailed phase_name (ExitFailure 1)))
removeFile tmp
#endif
return exit_code
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