setPgms,
setPgma,
setPgml,
+ setPgmDLL,
#ifdef ILX
setPgmI,
setPgmi,
import Config
import Outputable
import Panic ( GhcException(..) )
-import Util ( global, notNull )
+import Util ( global, notNull, toArgs )
import CmdLineOpts ( dynFlag, verbosity )
import EXCEPTION ( throwDyn )
openFile, hPutStrLn, hPutStr, hClose, hFlush, IOMode(..),
stderr )
import Directory ( doesFileExist, removeFile )
-import List ( intersperse, partition )
+import List ( partition )
#include "../includes/config.h"
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
setPgms = writeIORef v_Pgm_s
setPgma = writeIORef v_Pgm_a
setPgml = writeIORef v_Pgm_l
+setPgmDLL = writeIORef v_Pgm_MkDLL
#ifdef ILX
setPgmI = writeIORef v_Pgm_I
setPgmi = writeIORef v_Pgm_i
runSomething phase_name pgm args = do
let real_args = filter notNull (map showOpt args)
- traceCmd phase_name (concat (intersperse " " (pgm:real_args))) $ do
- exit_code <- rawSystem pgm real_args
+ -- Don't assume that 'pgm' contains the program path only,
+ -- but split it up and shift any arguments over to the arg vector.
+ let (real_pgm, argv) =
+ 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
+ exit_code <- rawSystem real_pgm argv
if (exit_code /= ExitSuccess)
then throwDyn (PhaseFailed phase_name exit_code)
else return ()
-- -----------------------------------------------------------------------------
-- 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
-- a single string. Command-line parsing is done by the executable
-- itself.
rawSystem cmd args = do
- let cmdline = {-translate-} cmd ++ concat (map ((' ':) . translate) args)
- -- Urk, don't quote/escape the command name on Windows, because the
- -- compiler is exceedingly naughty and sometimes uses 'perl "..."'
- -- as the command name.
+ -- NOTE: 'cmd' is assumed to contain the application to run _only_,
+ -- as it'll be quoted surrounded in quotes here.
+ let cmdline = translate cmd ++ concat (map ((' ':) . translate) args)
withCString cmdline $ \pcmdline -> do
status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmdline)
case status of
n -> return (ExitFailure n)
translate :: String -> String
+-- Returns a string wrapped in double-quotes
+-- If the input string starts with double-quote, don't touch it
+-- If not, wrap it in double-quotes and double any backslashes
+-- foo\baz --> "foo\\baz"
+-- "foo\baz" --> "foo\baz"
+
+translate str@('"':_) = str -- already escaped.
translate str = '"' : foldr escape "\"" str
where escape '"' str = '\\' : '"' : str
- escape '\\' str = '\\' : '\\' : str
escape c str = c : str
foreign import ccall "rawSystem" unsafe