[project @ 2004-02-25 13:54:30 by simonpj]

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

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index 912636a..da940ad 100644 (file)
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -105,7 +105,7 @@ import Foreign
 import CString         ( CString, peekCString )
 #endif
 
-#if __GLASGOW_HASKELL__ < 601
+#if __GLASGOW_HASKELL__ < 603
 import Foreign         ( withMany, withArray0, nullPtr, Ptr )
 import CForeign                ( CString, withCString, throwErrnoIfMinus1 )
 #else
@@ -735,7 +735,7 @@ runSomething phase_name pgm args = do
         case toArgs pgm of
          []     -> (pgm, real_args) -- let rawSystem be the bearer of bad news..
          (x:xs) -> (x, xs ++ real_args)
-  traceCmd phase_name (unwords (pgm:real_args)) $ do
+  traceCmd phase_name (unwords (real_pgm : argv)) $ do
   exit_code <- rawSystem real_pgm argv
   if (exit_code /= ExitSuccess)
        then throwDyn (PhaseFailed phase_name exit_code)
@@ -764,10 +764,19 @@ traceCmd phase_name cmd_line action
 
 -- -----------------------------------------------------------------------------
 -- rawSystem: run an external command
+--
+-- In GHC 6.2.1 there's a correct implementation of rawSystem in the
+-- library System.Cmd.  If we are compiling with an earlier version of
+-- GHC than this, we'd better have a copy of the correct implementation
+-- right here.
+
+-- If you ever alter this code, you must alter 
+--     libraries/base/System/Cmd.hs
+-- at the same time!  There are also exensive comments in System.Cmd
+-- thare are not repeated here -- go look!
 
-#if __GLASGOW_HASKELL__ < 601
 
--- This code is copied from System.Cmd on GHC 6.1.
+#if __GLASGOW_HASKELL__ < 603
 
 rawSystem :: FilePath -> [String] -> IO ExitCode
 
@@ -802,10 +811,24 @@ rawSystem cmd args = do
 
 translate :: String -> String
 translate str@('"':_) = str -- already escaped.
-translate str = '"' : foldr escape "\"" str
-  where escape '"'  str = '\\' : '"'  : str
-       escape '\\' str = '\\' : '\\' : str
-       escape c    str = c : str
+       -- ToDo: this case is wrong.  It is only here because we
+       -- abuse the system in GHC's SysTools by putting arguments into
+       -- the command name; at some point we should fix it up and remove
+       -- the case above.
+translate str = '"' : snd (foldr escape (True,"\"") str)
+  where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
+        escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
+        escape '\\' (False, str) = (False, '\\' : str)
+       escape c    (b,     str) = (False, c : str)
+       -- This function attempts to invert the Microsoft C runtime's
+       -- quoting rules, which can be found here:
+       --     http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
+       -- (if this URL stops working, you might be able to find it by
+       -- searching for "Parsing C Command-Line Arguments" on MSDN).
+       --
+       -- The Bool passed back along the string is True iff the
+       -- rest of the string is a sequence of backslashes followed by
+       -- a double quote.
 
 foreign import ccall "rawSystem" unsafe
   c_rawSystem :: CString -> IO Int