Commit fbc2537c authored by thomie's avatar thomie Committed by Ben Gamari

OPTIONS_GHC compiler flags may contain spaces (#4931)

When a .hsc contains `#define FOO "bar baz"`, hsc2hs emits:

    {-# OPTIONS_GHC -optc-DFOO="bar baz" #-}

Make sure GHC can compile this, by tweaking `HeaderInfo.getOptions` a
bit.

Test Plan: driver/T4931

Reviewers: austin, bgamari

Reviewed By: bgamari

Differential Revision: https://phabricator.haskell.org/D1452

GHC Trac Issues: #4931
parent 5eb56edd
......@@ -236,8 +236,9 @@ getOptions' dflags toks
parseToks (open:close:xs)
| IToptions_prag str <- getToken open
, ITclose_prag <- getToken close
= map (L (getLoc open)) (words str) ++
parseToks xs
= case toArgs str of
Left err -> panic ("getOptions'.parseToks: " ++ err)
Right args -> map (L (getLoc open)) args ++ parseToks xs
parseToks (open:close:xs)
| ITinclude_prag str <- getToken open
, ITclose_prag <- getToken close
......
......@@ -872,22 +872,35 @@ toArgs str
Left ("Couldn't read " ++ show str ++ "as [String]")
s -> toArgs' s
where
toArgs' :: String -> Either String [String]
-- Remove outer quotes:
-- > toArgs' "\"foo\" \"bar baz\""
-- Right ["foo", "bar baz"]
--
-- Keep inner quotes:
-- > toArgs' "-DFOO=\"bar baz\""
-- Right ["-DFOO=\"bar baz\""]
toArgs' s = case dropWhile isSpace s of
[] -> Right []
('"' : _) -> case reads s of
[(arg, rest)]
-- rest must either be [] or start with a space
| all isSpace (take 1 rest) ->
case toArgs' rest of
Left err -> Left err
Right args -> Right (arg : args)
_ ->
Left ("Couldn't read " ++ show s ++ "as String")
s' -> case break isSpace s' of
(arg, s'') -> case toArgs' s'' of
Left err -> Left err
Right args -> Right (arg : args)
('"' : _) -> do
-- readAsString removes outer quotes
(arg, rest) <- readAsString s
(arg:) `fmap` toArgs' rest
s' -> case break (isSpace <||> (== '"')) s' of
(argPart1, s''@('"':_)) -> do
(argPart2, rest) <- readAsString s''
-- show argPart2 to keep inner quotes
((argPart1 ++ show argPart2):) `fmap` toArgs' rest
(arg, s'') -> (arg:) `fmap` toArgs' s''
readAsString :: String -> Either String (String, String)
readAsString s = case reads s of
[(arg, rest)]
-- rest must either be [] or start with a space
| all isSpace (take 1 rest) ->
Right (arg, rest)
_ ->
Left ("Couldn't read " ++ show s ++ "as String")
{-
-- -----------------------------------------------------------------------------
-- Floats
......
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -DFOO="bar baz" #-}
main = print FOO
-- Test that GHC can compile option pragmas containing spaces.
-- When a .hsc contains `#define FOO "bar baz"`, hsc2hs emits:
--
-- {-# OPTIONS_GHC -optc-DFOO="bar baz" #-}
......@@ -459,3 +459,4 @@ test('T9360b', normal, run_command, ['{compiler} -e "" --interactive'])
test('T10970', normal, compile_and_run, ['-hide-all-packages -package base -package containers'])
test('T10970a', normal, compile_and_run, [''])
test('T4931', normal, compile_and_run, [''])
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