summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2022-04-07 21:46:10 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-04-08 13:58:19 -0400
commit0736e949b71a0c2b5eb404aac7a5883dd52b7b5c (patch)
tree40c719a82f0d0f3313f93548f1bb94f45e1e1f1f
parentd448049040d8f7b9b75863b096d08d16d6810f96 (diff)
downloadhaskell-0736e949b71a0c2b5eb404aac7a5883dd52b7b5c.tar.gz
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.
-rw-r--r--compiler/GHC/Parser/PostProcess.hs5
-rw-r--r--testsuite/tests/parser/should_fail/T16999.hs6
-rw-r--r--testsuite/tests/parser/should_fail/T16999.stderr2
-rw-r--r--testsuite/tests/parser/should_fail/all.T1
4 files changed, 11 insertions, 3 deletions
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, [''])