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 )
; let installed :: FilePath -> FilePath
installed file = top_dir </> file
installed_mingw_bin file = top_dir </> ".." </> "mingw" </> "bin" </> file
+ installed_perl_bin file = top_dir </> ".." </> "perl" </> 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"
; 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
| isWindowsHost = installed_mingw_bin "gcc"
| otherwise = cGCC
perl_path
- | isWindowsHost = installed cGHC_PERL
+ | isWindowsHost = installed_perl_bin cGHC_PERL
| otherwise = cGHC_PERL
-- 'touch' is a GHC util for Windows
touch_path
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 =
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
newTempName dflags extn
= do d <- getTempDir dflags
x <- getProcessID
- findTempName (d ++ "/ghc" ++ show x ++ "_") 0
+ findTempName (d </> "ghc" ++ show x ++ "_") 0
where
findTempName :: FilePath -> Integer -> IO FilePath
findTempName prefix x
-- 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.
| 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