diff options
| -rw-r--r-- | compiler/main/HeaderInfo.hs | 5 | ||||
| -rw-r--r-- | compiler/utils/Util.hs | 41 | ||||
| -rw-r--r-- | testsuite/tests/driver/T4931.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/driver/T4931.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/driver/all.T | 1 |
5 files changed, 40 insertions, 16 deletions
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index b4c3f81678..08c761994a 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -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 diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index e9b9d3f3df..7139eea6e9 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -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 diff --git a/testsuite/tests/driver/T4931.hs b/testsuite/tests/driver/T4931.hs new file mode 100644 index 0000000000..08b583a68d --- /dev/null +++ b/testsuite/tests/driver/T4931.hs @@ -0,0 +1,8 @@ +{-# 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" #-} diff --git a/testsuite/tests/driver/T4931.stdout b/testsuite/tests/driver/T4931.stdout new file mode 100644 index 0000000000..447cd7a651 --- /dev/null +++ b/testsuite/tests/driver/T4931.stdout @@ -0,0 +1 @@ +"bar baz" diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 7c74cb690a..5c0de6eaec 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -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, ['']) |