Commit 33842e2c authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Figure out if hsc2hs is using gcc or ghc as it's C compiler

and pass the appropriate flags on the basis of knowing that.
This is a hack.
What we should do longer term is make hsc2hs always use gcc as it's C compiler
and have Cabal figure out the right flags to pass it, rather than using ghc
to pass on the appropriate flags to gcc.
parent 5c70012a
......@@ -74,7 +74,7 @@ import Distribution.Simple.Program (Program(..), ConfiguredProgram(..),
import Distribution.Version (Version(..))
import Distribution.Verbosity
import Control.Monad (when, unless)
import Control.Monad (when, unless, join)
import Data.Maybe (fromMaybe)
import Data.List (nub)
import System.Directory (removeFile, getModificationTime)
......@@ -358,11 +358,12 @@ use_optP_P lbi
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHsc2hs bi lbi = pp
where pp = standardPP lbi hsc2hsProgram flags
flags = case compilerFlavor (compiler lbi) of
flags = case fmap versionTags . join . fmap programVersion
. lookupProgram hsc2hsProgram . withPrograms $ lbi of
-- Just to make things complicated, the hsc2hs bundled with
-- ghc uses ghc as the C compiler, so to pass C flags we
-- have to use an additional layer of escaping. Grrr.
GHC ->
Just ["ghc"] ->
let Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
in [ "--cc=" ++ programPath ghcProg
, "--ld=" ++ programPath ghcProg ]
......
......@@ -85,11 +85,14 @@ module Distribution.Simple.Program (
import qualified Distribution.Compat.Map as Map
import Distribution.Compat.Directory (findExecutable)
import Distribution.Simple.Utils (die, debug, warn, rawSystemExit, rawSystemStdout)
import Distribution.Version (Version, readVersion, showVersion,
import Distribution.Compat.TempFile (withTempFile)
import Distribution.Simple.Utils (die, debug, warn, rawSystemExit,
rawSystemStdout, rawSystemStdout')
import Distribution.Version (Version(..), readVersion, showVersion,
VersionRange(..), withinRange, showVersionRange)
import Distribution.Verbosity
import System.Directory (doesFileExist)
import System.Directory (doesFileExist, removeFile)
import System.FilePath (dropExtension)
import Control.Monad (join, foldM)
import Control.Exception as Exception (catch)
......@@ -542,11 +545,31 @@ arProgram = simpleProgram "ar"
hsc2hsProgram :: Program
hsc2hsProgram = (simpleProgram "hsc2hs") {
programFindVersion = findProgramVersion "--version" $ \str ->
-- Invoking "hsc2hs --version" gives a string like "hsc2hs version 0.66"
case words str of
(_:_:ver:_) -> ver
_ -> ""
programFindVersion = \verbosity path -> do
maybeVersion <- findProgramVersion "--version" (\str ->
-- Invoking "hsc2hs --version" gives a string like "hsc2hs version 0.66"
case words str of
(_:_:ver:_) -> ver
_ -> "") verbosity path
-- It turns out that it's important to know if hsc2hs is using gcc or ghc
-- as it's C compiler since this affects how we escape C options.
-- So here's a cunning hack, we make a temp .hsc file and call:
-- hsch2s tmp.hsc --cflag=--version
-- which passes --version through to ghc/gcc and we look at the result
-- to see if it was indeed ghc or not.
case maybeVersion of
Nothing -> return Nothing
Just version ->
withTempFile "." "hsc" $ \hsc -> do
writeFile hsc ""
(str, _) <- rawSystemStdout' verbosity path [hsc, "--cflag=--version"]
removeFile (dropExtension hsc ++ "_hsc_make.c")
case words str of
(_:"Glorious":"Glasgow":"Haskell":_)
-> return $ Just version { versionTags = ["ghc"] }
_ -> return $ Just version
}
c2hsProgram :: Program
......
......@@ -49,6 +49,7 @@ module Distribution.Simple.Utils (
wrapText,
rawSystemExit,
rawSystemStdout,
rawSystemStdout',
maybeExit,
xargs,
matchesDescFile,
......@@ -247,6 +248,12 @@ rawSystemPathExit verbosity prog args = do
-- Run a command and return its output
rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO String
rawSystemStdout verbosity path args = do
(output, exitCode) <- rawSystemStdout' verbosity path args
unless (exitCode == ExitSuccess) $ exitWith exitCode
return output
rawSystemStdout' :: Verbosity -> FilePath -> [String] -> IO (String, ExitCode)
rawSystemStdout' verbosity path args = do
printRawCommandAndArgs verbosity path args
#if __GLASGOW_HASKELL__ >= 604
......@@ -265,16 +272,16 @@ rawSystemStdout verbosity path args = do
$ \((tmpName, tmpHandle), nullHandle) -> do
cmdHandle <- runProcess path args Nothing Nothing
Nothing (Just tmpHandle) (Just nullHandle)
maybeExit (waitForProcess cmdHandle)
exitCode <- waitForProcess cmdHandle
output <- readFile tmpName
evaluate (length output)
return output
return (output, exitCode)
#else
withTempFile "." "" $ \tmpName -> do
let quote name = "'" ++ name ++ "'"
maybeExit $ system $ unwords (map quote (path:args)) ++ " >" ++ quote tmpName
exitCode <- system $ unwords (map quote (path:args)) ++ " >" ++ quote tmpName
output <- readFile tmpName
length output `seq` return output
length output `seq` return (output, exitCode)
#endif
-- | Like the unix xargs program. Useful for when we've got very long command
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment