Commit 6b07a72b authored by Ben Gamari's avatar Ben Gamari 🐢
Browse files

Parse C compiler flags from GHC correctly

GHC hands us a String which we previously tried to parse as a [String],
causing GHC's compiler flags to be ignored.
parent f89b6b63
......@@ -237,6 +237,7 @@ library
Distribution.Compat.CopyFile
Distribution.Compat.TempFile
Distribution.GetOpt
Distribution.Lex
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.IPI641
Distribution.Simple.GHC.IPI642
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Lex
-- Copyright : Ben Gamari 2015-2019
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- This module contains a simple lexer supporting quoted strings
module Distribution.Lex (
tokenizeQuotedWords
) where
import Data.Char (isSpace)
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
newtype DList a = DList ([a] -> [a])
runDList :: DList a -> [a]
runDList (DList run) = run []
singleton :: a -> DList a
singleton a = DList (a:)
instance Monoid (DList a) where
mempty = DList id
DList a `mappend` DList b = DList (a . b)
tokenizeQuotedWords :: String -> [String]
tokenizeQuotedWords = filter (not . null) . go False mempty
where
go :: Bool -- ^ in quoted region
-> DList Char -- ^ accumulator
-> String -- ^ string to be parsed
-> [String] -- ^ parse result
go _ accum []
| [] <- accum' = []
| otherwise = [accum']
where accum' = runDList accum
go False accum (c:cs)
| isSpace c = runDList accum : go False mempty cs
| c == '"' = go True accum cs
go True accum (c:cs)
| c == '"' = go False accum cs
go quoted accum (c:cs)
= go quoted (accum `mappend` singleton c) cs
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.GHC.Internal
......@@ -38,6 +39,7 @@ import Distribution.PackageDescription as PD
( BuildInfo(..), Library(..), libModules
, hcOptions, usedExtensions, ModuleRenaming, lookupRenaming )
import Distribution.Compat.Exception ( catchExit, catchIO )
import Distribution.Lex (tokenizeQuotedWords)
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), DebugInfoLevel(..), OptimisationLevel(..) )
import Distribution.Simple.Program.GHC
......@@ -146,12 +148,19 @@ configureToolchain implInfo ghcProg ghcInfo =
gccLinkerFlags = getFlags "Gcc Linker flags"
ldLinkerFlags = getFlags "Ld Linker flags"
getFlags key = case M.lookup key ghcInfo of
Nothing -> []
Just flags ->
case reads flags of
[(args, "")] -> args
_ -> [] -- XXX Should should be an error really
-- It appears that GHC 7.6 and earlier encode the tokenized flags as a
-- [String] in these settings whereas later versions just encode the flags as
-- String.
--
-- We first try to parse as a [String] and if this fails then tokenize the
-- flags ourself.
getFlags :: String -> [String]
getFlags key =
case M.lookup key ghcInfo of
Nothing -> []
Just flags
| (flags', ""):_ <- reads flags -> flags'
| otherwise -> tokenizeQuotedWords flags
configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureGcc v gccProg = do
......
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