Make a mingw tree from mingw tarballs

[ghc-hetmet.git] / compiler / main / SysTools.lhs

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index a64d73e..c8960dc 100644 (file)
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -55,14 +55,13 @@ import System.IO
 import System.IO.Error as IO
 import System.Directory
 import Data.Char
-import Data.Maybe
 import Data.List
 
 #ifndef mingw32_HOST_OS
 import qualified System.Posix.Internals
 #else /* Must be Win32 */
 import Foreign
-import CString          ( CString, peekCString )
+import Foreign.C.String
 #endif
 
 import System.Process   ( runInteractiveProcess, getProcessExitCode )
@@ -161,7 +160,7 @@ initSysTools mbMinusB dflags0
               installed file = top_dir </> file
               installed_mingw_bin file = top_dir </> ".." </> "mingw" </> "bin" </> file
 
-        ; let pkgconfig_path      = installed "package.conf"
+        ; let pkgconfig_path = installed "package.conf.d"
               ghc_usage_msg_path  = installed "ghc-usage.txt"
               ghci_usage_msg_path = installed "ghci-usage.txt"
 
@@ -178,12 +177,6 @@ initSysTools mbMinusB dflags0
         ; tmpdir <- getTemporaryDirectory
         ; let dflags1 = setTmpDir tmpdir dflags0
 
-        -- Check that the package config exists
-        ; config_exists <- doesFileExist pkgconfig_path
-        ; when (not config_exists) $
-             ghcError (InstallationError
-                         ("Can't find package.conf as " ++ pkgconfig_path))
-
         -- On Windows, mingw is distributed with GHC,
         --      so we look in TopDir/../mingw/bin
         ; let
@@ -191,7 +184,7 @@ initSysTools mbMinusB dflags0
                 | isWindowsHost = installed_mingw_bin "gcc"
                 | otherwise     = cGCC
               perl_path
-                | isWindowsHost = installed cGHC_PERL
+                | isWindowsHost = installed_mingw_bin cGHC_PERL
                 | otherwise     = cGHC_PERL
               -- 'touch' is a GHC util for Windows
               touch_path
@@ -403,10 +396,24 @@ runMkDLL dflags args = do
 
 runWindres :: DynFlags -> [Option] -> IO ()
 runWindres dflags args = do
-  let (_gcc,gcc_args) = pgm_c dflags
-      windres        = pgm_windres dflags
+  let (gcc, gcc_args) = pgm_c dflags
+      windres = pgm_windres dflags
+      quote x = "\"" ++ x ++ "\""
+      args' = -- If windres.exe and gcc.exe are in a directory containing
+              -- spaces then windres fails to run gcc. We therefore need
+              -- to tell it what command to use...
+              Option ("--preprocessor=" ++
+                      unwords (map quote (gcc :
+                                          map showOpt gcc_args ++
+                                          ["-E", "-xc", "-DRC_INVOKED"])))
+              -- ...but if we do that then if windres calls popen then
+              -- it can't understand the quoting, so we have to use
+              -- --use-temp-file so that it interprets it correctly.
+              -- See #1828.
+            : Option "--use-temp-file"
+            : args
   mb_env <- getGccEnv gcc_args
-  runSomethingFiltered dflags id "Windres" windres args mb_env
+  runSomethingFiltered dflags id "Windres" windres args' mb_env
 
 touch :: DynFlags -> String -> String -> IO ()
 touch dflags purpose arg =
@@ -420,12 +427,13 @@ copyWithHeader :: DynFlags -> String -> Maybe String -> FilePath -> FilePath
 copyWithHeader dflags purpose maybe_header from to = do
   showPass dflags purpose
 
-  h <- openFile to WriteMode
-  ls <- readFile from -- inefficient, but it'll do for now.
-                      -- ToDo: speed up via slurping.
-  maybe (return ()) (hPutStr h) maybe_header
-  hPutStr h ls
-  hClose h
+  hout <- openBinaryFile to   WriteMode
+  hin  <- openBinaryFile from ReadMode
+  ls <- hGetContents hin -- inefficient, but it'll do for now. ToDo: speed up
+  maybe (return ()) (hPutStr hout) maybe_header
+  hPutStr hout ls
+  hClose hout
+  hClose hin
 
 getExtraViaCOpts :: DynFlags -> IO [String]
 getExtraViaCOpts dflags = do
@@ -607,8 +615,8 @@ builderMainLoop dflags filter_fn pgm real_args mb_env = do
   -- and run a loop piping the output from the compiler to the log_action in DynFlags
   hSetBuffering hStdOut LineBuffering
   hSetBuffering hStdErr LineBuffering
-  forkIO (readerProc chan hStdOut filter_fn)
-  forkIO (readerProc chan hStdErr filter_fn)
+  _ <- forkIO (readerProc chan hStdOut filter_fn)
+  _ <- forkIO (readerProc chan hStdErr filter_fn)
   -- we don't want to finish until 2 streams have been completed
   -- (stdout and stderr)
   -- nor until 1 exit code has been retrieved.
@@ -711,10 +719,6 @@ data BuildMessage
   | BuildError !SrcLoc !SDoc
   | EOF
 
-showOpt :: Option -> String
-showOpt (FileOption pre f) = pre ++ f
-showOpt (Option s)  = s
-
 traceCmd :: DynFlags -> String -> String -> IO () -> IO ()
 -- a) trace the command (at two levels of verbosity)
 -- b) don't do it at all if dry-run is set