diff options
author | roland <rsx@bluewin.ch> | 2018-09-04 14:09:20 +0200 |
---|---|---|
committer | Krzysztof Gogolewski <krz.gogolewski@gmail.com> | 2018-09-04 14:09:20 +0200 |
commit | df363a646b66f4dd13d63ec70f18e427cabc8878 (patch) | |
tree | 14fa4093f8e7620f5140bd4bc1d5346bfc45021d | |
parent | fa3143c76ac77ee96fd89559cacc089205abaa20 (diff) | |
download | haskell-df363a646b66f4dd13d63ec70f18e427cabc8878.tar.gz |
Compiler panic on invalid syntax (unterminated pragma)
Summary: After a parse error in OPTIONS_GHC issue an error message instead of a compiler panic.
Test Plan: make test TEST=T15053
Reviewers: Phyx, thomie, bgamari, monoidal, osa1
Reviewed By: Phyx, monoidal, osa1
Subscribers: tdammers, osa1, rwbarton, carter
GHC Trac Issues: #15053
Differential Revision: https://phabricator.haskell.org/D5093
-rw-r--r-- | compiler/main/HeaderInfo.hs | 22 | ||||
-rw-r--r-- | testsuite/tests/parser/should_fail/T15053.stderr | 5 | ||||
-rw-r--r-- | testsuite/tests/parser/should_fail/all.T | 2 |
3 files changed, 22 insertions, 7 deletions
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 76f67b25db..127cc6d911 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -244,7 +244,8 @@ getOptions' dflags toks | IToptions_prag str <- getToken open , ITclose_prag <- getToken close = case toArgs str of - Left err -> panic ("getOptions'.parseToks: " ++ err) + Left _err -> optionsParseError str dflags $ -- #15053 + combineSrcSpans (getLoc open) (getLoc close) Right args -> map (L (getLoc open)) args ++ parseToks xs parseToks (open:close:xs) | ITinclude_prag str <- getToken open @@ -314,17 +315,15 @@ checkExtension dflags (L l ext) languagePragParseError :: DynFlags -> SrcSpan -> a languagePragParseError dflags loc = - throw $ mkSrcErr $ unitBag $ - (mkPlainErrMsg dflags loc $ + throwErr dflags loc $ vcat [ text "Cannot parse LANGUAGE pragma" , text "Expecting comma-separated list of language options," , text "each starting with a capital letter" - , nest 2 (text "E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ]) + , nest 2 (text "E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ] unsupportedExtnError :: DynFlags -> SrcSpan -> String -> a unsupportedExtnError dflags loc unsup = - throw $ mkSrcErr $ unitBag $ - mkPlainErrMsg dflags loc $ + throwErr dflags loc $ text "Unsupported extension: " <> text unsup $$ if null suggestions then Outputable.empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions) where @@ -340,3 +339,14 @@ optionsErrorMsgs dflags unhandled_flags flags_lines _filename ErrUtils.mkPlainErrMsg dflags flagSpan $ text "unknown flag in {-# OPTIONS_GHC #-} pragma:" <+> text flag +optionsParseError :: String -> DynFlags -> SrcSpan -> a -- #15053 +optionsParseError str dflags loc = + throwErr dflags loc $ + vcat [ text "Error while parsing OPTIONS_GHC pragma." + , text "Expecting whitespace-separated list of GHC options." + , text " E.g. {-# OPTIONS_GHC -Wall -O2 #-}" + , text ("Input was: " ++ show str) ] + +throwErr :: DynFlags -> SrcSpan -> SDoc -> a -- #15053 +throwErr dflags loc doc = + throw $ mkSrcErr $ unitBag $ mkPlainErrMsg dflags loc doc diff --git a/testsuite/tests/parser/should_fail/T15053.stderr b/testsuite/tests/parser/should_fail/T15053.stderr new file mode 100644 index 0000000000..0544327c5e --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15053.stderr @@ -0,0 +1,5 @@ +T15053.hs:1:16: + Error while parsing OPTIONS_GHC pragma. + Expecting whitespace-separated list of GHC options. + E.g. {-# OPTIONS_GHC -Wall -O2 #-} + Input was: " -O1 }/n/"/n " diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index 73e817d151..8233d767f4 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -126,4 +126,4 @@ test('typeops_A', normal, compile_fail, ['']) test('typeops_B', normal, compile_fail, ['']) test('typeops_C', normal, compile_fail, ['']) test('typeops_D', normal, compile_fail, ['']) -test('T15053', expect_broken(15053), compile_fail, ['']) # shouldn't panic +test('T15053', normal, compile_fail, ['']) |