From 0736e949b71a0c2b5eb404aac7a5883dd52b7b5c Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Thu, 7 Apr 2022 21:46:10 +0300 Subject: Disallow (->) as a data constructor name (#16999) The code was misusing isLexCon, which was never meant for validation. In fact, its documentation states the following: Use these functions to figure what kind of name a 'FastString' represents; these functions do /not/ check that the identifier is valid. Ha! This sign can't stop me because I can't read. The fix is to use okConOcc instead. The other checks (isTcOcc or isDataOcc) seem superfluous, so I also removed those. --- compiler/GHC/Parser/PostProcess.hs | 5 ++--- testsuite/tests/parser/should_fail/T16999.hs | 6 ++++++ testsuite/tests/parser/should_fail/T16999.stderr | 2 ++ testsuite/tests/parser/should_fail/all.T | 1 + 4 files changed, 11 insertions(+), 3 deletions(-) create mode 100644 testsuite/tests/parser/should_fail/T16999.hs create mode 100644 testsuite/tests/parser/should_fail/T16999.stderr diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 1530e9ab12..8a89bef84d 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -134,7 +134,7 @@ import GHC.Parser.Types import GHC.Parser.Lexer import GHC.Parser.Errors.Types import GHC.Parser.Errors.Ppr () -import GHC.Utils.Lexeme ( isLexCon ) +import GHC.Utils.Lexeme ( okConOcc ) import GHC.Types.TyThing import GHC.Core.Type ( unrestrictedFunTyCon, Specificity(..) ) import GHC.Builtin.Types( cTupleTyConName, tupleTyCon, tupleDataCon, @@ -639,8 +639,7 @@ constructor, a type, or a context, we would need unlimited lookahead which -- See Note [Parsing data constructors is hard] tyConToDataCon :: LocatedN RdrName -> Either (MsgEnvelope PsMessage) (LocatedN RdrName) tyConToDataCon (L loc tc) - | isTcOcc occ || isDataOcc occ - , isLexCon (occNameFS occ) + | okConOcc (occNameString occ) = return (L loc (setRdrNameSpace tc srcDataName)) | otherwise diff --git a/testsuite/tests/parser/should_fail/T16999.hs b/testsuite/tests/parser/should_fail/T16999.hs new file mode 100644 index 0000000000..d43612d035 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T16999.hs @@ -0,0 +1,6 @@ +module T16999 where + +data Type + = TBool + | TInt + | (->) Type Type diff --git a/testsuite/tests/parser/should_fail/T16999.stderr b/testsuite/tests/parser/should_fail/T16999.stderr new file mode 100644 index 0000000000..16b3235dd1 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T16999.stderr @@ -0,0 +1,2 @@ + +T16999.hs:6:5: error: Not a data constructor: ‘->’ diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index 253d9bcff2..4d70833bed 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -207,3 +207,4 @@ test('OpaqueParseFail3', normal, compile_fail, ['']) test('OpaqueParseFail4', normal, compile_fail, ['']) test('T20385A', normal, compile_fail, ['']) test('T20385B', normal, compile_fail, ['']) +test('T16999', normal, compile_fail, ['']) -- cgit v1.2.1