diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 76f67b25dbdfc24cfdb7fee02ea60401fc8fb7fe..127cc6d911000555b11a38ebbd976dab859f3fed 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 0000000000000000000000000000000000000000..0544327c5e2c98bcca73ef5e1ee3c369104d68d2 --- /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 93d0e0a9dda68b31161cad4194bb3ae6a101d0ed..cf1202f943a0775f6764c15858111f61dce45b17 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -125,4 +125,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, [''])