[project @ 2003-06-06 10:43:22 by panne]

Quick fix: Escape double quotes when quoting; affects only WinDoze
builds. While I'm there: Move quoting hell into #ifdef, so its scope
is obvious and changed an #ifndef into an #ifdef (negated conditions
are evil, at least for my small brain).

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index b908b2c..125be5b 100644 (file)
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -516,9 +516,6 @@ data Option
              String  -- the filepath/filename portion
  | Option     String
  
-showOptions :: [Option] -> String
-showOptions ls = unwords (map (quote.showOpt) ls)
-
 showOpt (FileOption pre f) = pre ++ dosifyPath f
 showOpt (Option "") = ""
 showOpt (Option s)  = s
@@ -707,7 +704,23 @@ runSomething :: String             -- For -v message
 runSomething phase_name pgm args
  = traceCmd phase_name (concat (intersperse " " (pgm:quoteargs))) $
    do
-#ifndef mingw32_HOST_OS
+#ifdef mingw32_HOST_OS
+          let showOptions :: [Option] -> String
+              showOptions ls = unwords (map (quote . showOpt) ls)
+
+              quote :: String -> String
+              quote "" = ""
+              quote s  = "\"" ++ escapeDoubleQuotes s ++ "\""
+
+              escapeDoubleQuotes :: String -> String
+              escapeDoubleQuotes ""            = ""
+              escapeDoubleQuotes ('\\':'"':cs) = '\\':'"':escapeDoubleQuotes cs
+              escapeDoubleQuotes (     '"':cs) = '\\':'"':escapeDoubleQuotes cs
+              escapeDoubleQuotes (c       :cs) = c       :escapeDoubleQuotes cs
+
+          -- The pgm is already in native format (appropriate dir separators)
+          exit_code <- rawSystem (pgm ++ ' ':showOptions args)
+#else
           mpid <- forkProcess
           exit_code <- case mpid of
             Nothing -> do -- Child
@@ -727,17 +740,12 @@ runSomething phase_name pgm args
 #endif
 
               return res
-#else
-          exit_code <- rawSystem cmd_line
 #endif
-         when (exit_code /= ExitSuccess)
-           $ throwDyn (PhaseFailed phase_name exit_code)
+         when (exit_code /= ExitSuccess) $
+            throwDyn (PhaseFailed phase_name exit_code)
           return ()    
   where
-       -- The pgm is already in native format (appropriate dir separators)
-    cmd_line = pgm ++ ' ':showOptions args
-                -- unwords (pgm : dosifyPaths (map quote args))
-    quoteargs = filter (not.null) (map showOpt args)
+    quoteargs = filter (not . null) (map showOpt args)
 
 traceCmd :: String -> String -> IO () -> IO ()
 -- a) trace the command (at two levels of verbosity)
@@ -883,8 +891,4 @@ getProcessID :: IO Int
 getProcessID = Posix.getProcessID
 #endif
 
-quote :: String -> String
-quote "" = ""
-quote s  = "\"" ++ s ++ "\""
-
 \end{code}