[project @ 2000-12-11 12:30:58 by rrt]

[ghc-hetmet.git] / ghc / compiler / main / DriverUtil.hs

diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs
index 764be3f..4301d86 100644 (file)
--- a/ghc/compiler/main/DriverUtil.hs
+++ b/ghc/compiler/main/DriverUtil.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $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
 --
@@ -9,9 +9,11 @@
 
 module DriverUtil where
 
+#include "../includes/config.h"
 #include "HsVersions.h"
 
 import Util
+import TmpFiles ( newTempName )
 
 import IOExts
 import Exception
@@ -20,6 +22,7 @@ import RegexString
 
 import IO
 import System
+import Directory ( removeFile )
 import List
 import Char
 import Monad
@@ -181,3 +184,21 @@ 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
+   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