X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=e5f1a3156f1a256e8d37d38c2136db5db39e4551;hb=bfd0c33d39619b580520e2d6e43d306380393ea6;hp=2df9a7240702037e8524760a5494dbb2decfe1ec;hpb=206b4dec78250efef3cd927d64dc6cbc54a16c3d;p=ghc-hetmet.git diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 2df9a72..e5f1a31 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -72,17 +72,10 @@ import Foreign import CString ( CString, peekCString ) #endif -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603 --- rawSystem comes from libghccompat.a in stage1 -import Compat.RawSystem ( rawSystem ) -import System.Cmd ( system ) -import GHC.IOBase ( IOErrorType(..) ) -#else import System.Process ( runInteractiveProcess, getProcessExitCode ) import Control.Concurrent( forkIO, newChan, readChan, writeChan ) -import FastString ( mkFastString ) +import FastString import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan ) -#endif \end{code} @@ -174,7 +167,13 @@ initSysTools mbMinusB dflags ; let installed, installed_bin :: FilePath -> FilePath installed_bin pgm = top_dir pgm installed file = top_dir file - inplace dir pgm = top_dir cPROJECT_DIR dir pgm + inplace dir pgm = top_dir +#ifndef darwin_TARGET_OS +-- Not sure where cPROJECT_DIR makes sense, on Mac OS, building with +-- xcodebuild, it surely is a *bad* idea! -=chak + cPROJECT_DIR +#endif + dir pgm ; let pkgconfig_path | am_installed = installed "package.conf" @@ -208,31 +207,9 @@ initSysTools mbMinusB dflags | otherwise = "windres" ; let dflags0 = defaultDynFlags -#ifndef mingw32_HOST_OS - -- check whether TMPDIR is set in the environment - ; e_tmpdir <- IO.try (getEnv "TMPDIR") -- fails if not set -#else - -- On Win32, consult GetTempPath() for a temp dir. - -- => it first tries TMP, TEMP, then finally the - -- Windows directory(!). The directory is in short-path - -- form. - ; e_tmpdir <- - IO.try (do - let len = (2048::Int) - buf <- mallocArray len - ret <- getTempPath len buf - if ret == 0 then do - -- failed, consult TMPDIR. - free buf - getEnv "TMPDIR" - else do - s <- peekCString buf - free buf - return s) -#endif - ; let dflags1 = case e_tmpdir of - Left _ -> dflags0 - Right d -> setTmpDir d dflags0 + + ; tmpdir <- getTemporaryDirectory + ; let dflags1 = setTmpDir tmpdir dflags0 -- Check that the package config exists ; config_exists <- doesFileExist pkgconfig_path @@ -642,7 +619,7 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) in do createDirectory dirname let mapping' = addToFM mapping tmp_dir dirname writeIORef v_DirsToClean mapping' - debugTraceMsg dflags 2 (ptext SLIT("Created temporary directory:") <+> text dirname) + debugTraceMsg dflags 2 (ptext (sLit "Created temporary directory:") <+> text dirname) return dirname `IO.catch` \e -> if isAlreadyExistsError e @@ -686,8 +663,8 @@ removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO () removeWith dflags remover f = remover f `IO.catch` (\e -> let msg = if isDoesNotExistError e - then ptext SLIT("Warning: deleting non-existent") <+> text f - else ptext SLIT("Warning: exception raised when deleting") + then ptext (sLit "Warning: deleting non-existent") <+> text f + else ptext (sLit "Warning: exception raised when deleting") <+> text f <> colon $$ text (show e) in debugTraceMsg dflags 2 msg @@ -881,7 +858,7 @@ traceCmd dflags phase_name cmd_line action }} where handle_exn verb exn = do { debugTraceMsg dflags 2 (char '\n') - ; debugTraceMsg dflags 2 (ptext SLIT("Failed:") <+> text cmd_line <+> text (show exn)) + ; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn)) ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) } \end{code}