From af674cf036c7a0f8d15c0061966ebbd253c31f48 Mon Sep 17 00:00:00 2001
From: rrt <unknown>
Date: Fri, 22 Jun 2001 13:30:18 +0000
Subject: [PATCH] [project @ 2001-06-22 13:30:18 by rrt] Instead of using the
 old kludgedSystem on Windows, use the new system. This
 makes the use of DOS built-ins such as copy work, which
 they didn't when the command was run under sh (as the old
 kludgedSystem did).

---
 ghc/compiler/main/SysTools.lhs |   54 +++++++++++++++-------------------------
 1 file changed, 20 insertions(+), 34 deletions(-)

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index 392b9b2..fb9f564 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -52,12 +52,15 @@ import CmdLineOpts	( dynFlag, verbosity )
 import List		( isPrefixOf )
 import Exception	( throw, throwDyn, catchAllIO )
 import IO		( hPutStr, hPutChar, hPutStrLn, hFlush, stderr )
-import IO		( openFile, IOMode(..), hClose )	-- For temp "system"
 import Directory	( doesFileExist, removeFile )
 import IOExts		( IORef, readIORef, writeIORef )
 import Monad		( when, unless )
+#if defined(mingw32_TARGET_OS) && __GLASGOW_HASKELL__ < 501
 import qualified System
-import System		( ExitCode(..) )
+#else
+import System           ( system )
+#endif
+import System		( ExitCode(..), exitWith )
 
 #include "../includes/config.h"
 
@@ -228,7 +231,7 @@ initSysTools minusB_args
 	; let	cpp_path   = cRAWCPP
 		gcc_path   = cGCC
 		touch_path = cGHC_TOUCHY
-		mkdll_path = panic "Cant build DLLs on a non-Win32 system"
+		mkdll_path = panic "Can't build DLLs on a non-Win32 system"
 
 	-- On Unix, scripts are invoked using the '#!' method.  Binary
 	-- installations of GHC on Unix place the correct line on the front
@@ -418,7 +421,7 @@ Show the usage message and exit
 showGhcUsage = do { usage_path <- readIORef v_Path_usage
 		  ; usage      <- readFile usage_path
 		  ; dump usage
-		  ; System.exitWith System.ExitSuccess }
+		  ; exitWith ExitSuccess }
   where
      dump ""	      = return ()
      dump ('$':'$':s) = hPutStr stderr progName >> dump s
@@ -434,9 +437,6 @@ packageConfigPath = readIORef v_Path_package_config
 %*									*
 %************************************************************************
 
-One reason this code is here is because SysTools.system needs to make
-a temporary file.
-
 \begin{code}
 GLOBAL_VAR(v_FilesToClean, [],               [String] )
 GLOBAL_VAR(v_TmpDir,       cDEFAULT_TMPDIR,  String   )
@@ -519,13 +519,7 @@ runSomething phase_name pgm args
   	  else return ()
 	}
   where
--- Don't convert paths to DOS format when using the kludged
--- version of 'system' on mingw32.  See comments with 'system' below.
-#if __GLASGOW_HASKELL__ > 501
     cmd_line = unwords (dosifyPaths (pgm : args))
-#else
-    cmd_line = unwords (pgm : args)
-#endif
 
 traceCmd :: String -> String -> IO () -> IO ()
 -- a) trace the command (at two levels of verbosity)
@@ -673,30 +667,22 @@ long command lines.  But GHC may need to make a system call with
 a very long command line, notably when it links itself during
 bootstrapping.  
 
-Solution: when compiling SysTools for Windows, using GHC prior
-to 5.01, write the command to a file and use "sh" (not cmd.exe)
-to execute it.  Such GHCs require "sh" on the path, but once
-bootstrapped this problem goes away.
+Solution: import the new definition (which involves compiling up
+lib/std/cbits/system.c)
 
 ToDo: remove when compiling with GHC < 5 is not relevant any more
 
 \begin{code}
-system cmd
-
-#if !defined(mingw32_TARGET_OS) || __GLASGOW_HASKELL__ > 501
-    -- The usual case
- = System.system cmd
-
-#else	-- The Hackoid case
- = do pid     <- getProcessID
-      tmp_dir <- readIORef v_TmpDir
-      let tmp = tmp_dir++"/sh"++show pid
-      h <- openFile tmp WriteMode
-      hPutStrLn h cmd
-      hClose h
-      exit_code <- System.system ("sh - " ++ tmp) `catchAllIO` 
- 			         (\exn -> removeFile tmp >> throw exn)
-      removeFile tmp
-      return exit_code
+#if defined(mingw32_TARGET_OS) && __GLASGOW_HASKELL__ > 500
+-- copied from lib/std/System.lhs
+system cmd =
+  withUnsafeCString cmd $ \s -> do
+    status <- throwErrnoIfMinus1 "system" (primSystem s)
+    case status of
+        0  -> return ExitSuccess
+        n  -> return (ExitFailure n)
+system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
+
+foreign import ccall "systemCmd" unsafe primSystem :: UnsafeCString -> IO Int
 #endif
 \end{code}
-- 
1.7.10.4