import Config
import Outputable
import Panic ( GhcException(..) )
-import Util ( global, notNull, toArgs )
+import Util ( global, notNull )
import CmdLineOpts ( dynFlag, verbosity )
import EXCEPTION ( throwDyn )
import Directory ( doesFileExist, removeFile )
import List ( partition )
-#include "../includes/config.h"
+#include "../includes/ghcconfig.h"
-- GHC <= 4.08 didn't have rawSystem, and runs into problems with long command
-- lines on mingw32, so we disallow it now.
}
#if defined(mingw32_HOST_OS)
-foreign import stdcall "GetTempPathA" unsafe getTempPath :: Int -> CString -> IO Int32
+foreign import stdcall unsafe "GetTempPathA" getTempPath :: Int -> CString -> IO Int32
#endif
\end{code}
let real_args = filter notNull (map showOpt args)
traceCmd phase_name (unwords (pgm:real_args)) $ do
exit_code <- rawSystem pgm real_args
- if (exit_code /= ExitSuccess)
- then throwDyn (PhaseFailed phase_name exit_code)
- else return ()
+ case exit_code of
+ ExitSuccess ->
+ return ()
+ -- rawSystem returns (ExitFailure 127) if the exec failed for any
+ -- reason (eg. the program doesn't exist). This is the only clue
+ -- we have, but we need to report something to the user because in
+ -- the case of a missing program there will otherwise be no output
+ -- at all.
+ ExitFailure 127 ->
+ throwDyn (InstallationError ("could not execute: " ++ pgm))
+ ExitFailure _other ->
+ throwDyn (PhaseFailed phase_name exit_code)
traceCmd :: String -> String -> IO () -> IO ()
-- a) trace the command (at two levels of verbosity)
-- 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__ < 603
-
-rawSystem :: FilePath -> [String] -> IO ExitCode
-
-#ifndef mingw32_TARGET_OS
-
-rawSystem cmd args =
- withCString cmd $ \pcmd ->
- withMany withCString (cmd:args) $ \cstrs ->
- withArray0 nullPtr cstrs $ \arr -> do
- status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmd arr)
- case status of
- 0 -> return ExitSuccess
- n -> return (ExitFailure n)
-
-foreign import ccall "rawSystem" unsafe
- c_rawSystem :: CString -> Ptr CString -> IO Int
-
-#else
-
--- On Windows, the command line is passed to the operating system as
--- a single string. Command-line parsing is done by the executable
--- itself.
-rawSystem cmd args = do
- -- NOTE: 'cmd' is assumed to contain the application to run _only_,
- -- as it'll be 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
- 0 -> return ExitSuccess
- n -> return (ExitFailure n)
-
-translate :: String -> String
-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
-
-#endif
+#include "../../libraries/base/System/RawSystem.hs-inc"
#endif
\end{code}
where
rootDir s = reverse (dropList "/bin/ghc.exe" (reverse (normalisePath s)))
-foreign import stdcall "GetModuleFileNameA" unsafe
+foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
#else
getBaseDir :: IO (Maybe String) = do return Nothing
#endif
#ifdef mingw32_HOST_OS
-foreign import ccall "_getpid" unsafe getProcessID :: IO Int -- relies on Int == Int32 on Windows
+foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
#elif __GLASGOW_HASKELL__ > 504
getProcessID :: IO Int
getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral