From f8d8ea662828a295e27a2f5f52ce38d68fd3dee2 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 15 Jun 2001 15:20:20 +0000
Subject: [PATCH] [project @ 2001-06-15 15:20:20 by simonpj] * Restore
 SysTools.system, which implements a kludged version   of
 system for reasons that are explained at length in the
 comments   [overlong command-lines fail if compiling GHC
 with pre-5.02 GHCs]

* Wibble in Makefile
---
 ghc/compiler/Makefile          |    4 ++--
 ghc/compiler/main/SysTools.lhs |   51 ++++++++++++++++++++++++++++++++++++----
 2 files changed, 48 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index 1bf9cae..b975dfd 100644
--- a/ghc/compiler/Makefile
+++ b/ghc/compiler/Makefile
@@ -1,5 +1,5 @@
 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.159 2001/06/15 08:29:57 simonpj Exp $
+# $Id: Makefile,v 1.160 2001/06/15 15:20:20 simonpj Exp $
 
 TOP = ..
 include $(TOP)/mk/boilerplate.mk
@@ -51,7 +51,7 @@ $(CONFIG_HS) : $(FPTOOLS_TOP)/mk/config.mk Makefile
 	@echo "cMKDLL                = \"$(BLD_DLL)\"" >> $(CONFIG_HS)
 	@echo "cGHC_DRIVER_DIR       = \"$(GHC_DRIVER_DIR)\"" >> $(CONFIG_HS)
 	@echo "cGHC_TOUCHY           = \"$(GHC_TOUCHY)\"" >> $(CONFIG_HS)
-	@echo "cGHC_TOUCHY_DIR       = \"$(GHC_TOUCHY)\"" >> $(CONFIG_HS)
+	@echo "cGHC_TOUCHY_DIR       = \"$(GHC_TOUCHY_DIR)\"" >> $(CONFIG_HS)
 	@echo "cGHC_UNLIT            = \"$(GHC_UNLIT)\"" >> $(CONFIG_HS)
 	@echo "cGHC_UNLIT_DIR        = \"$(GHC_UNLIT_DIR)\"" >> $(CONFIG_HS)
 	@echo "cGHC_MANGLER          = \"$(GHC_MANGLER)\"" >> $(CONFIG_HS)
diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index 3b0bfba..271d947 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -33,7 +33,7 @@ module SysTools (
 
 	-- System interface
 	getProcessID,		-- IO Int
-	System.system, 		-- String -> IO Int	-- System.system
+	system, 		-- String -> IO Int
 
 	-- Misc
 	showGhcUsage,		-- IO ()	Shows usage message and exits
@@ -50,9 +50,10 @@ import Panic		( progName, GhcException(..) )
 import Util		( global )
 import CmdLineOpts	( dynFlag, verbosity )
 
-import List		( intersperse )
-import Exception	( throwDyn, catchAllIO )
+import List		( intersperse, 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 )
@@ -163,7 +164,7 @@ initSysTools minusB_args
 
 	; let installed_bin pgm   =  top_dir `slash` "bin" `slash` pgm
 	      installed     file  =  top_dir `slash` file
-	      inplace dir   pgm   =  top_dir `slash` dir `slash` pgm
+	      inplace dir   pgm   =  top_dir `slash` dosifyPath dir `slash` pgm
 
 	; let pkgconfig_path
 		| am_installed = installed "package.conf"
@@ -509,7 +510,7 @@ runSomething :: String		-- For -v message
 
 runSomething phase_name pgm args
  = traceCmd phase_name cmd_line $
-   do   { exit_code <- System.system cmd_line
+   do   { exit_code <- system cmd_line
 	; if exit_code /= ExitSuccess
 	  then throwDyn (PhaseFailed phase_name exit_code)
   	  else return ()
@@ -625,3 +626,43 @@ getProcessID = Posix.getProcessID
 getExecDir :: IO (Maybe String) = do return Nothing
 #endif
 \end{code}
+
+%************************************************************************
+%*									*
+\subsection{System}
+%*									*
+%************************************************************************
+
+In GHC prior to 5.01 (or so), on Windows, the implementation
+of "system" in the library System.system does not work for very 
+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.
+
+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
+#endif
+\end{code}
\ No newline at end of file
-- 
1.7.10.4