diff options
| author | sheaf <sam.derbyshire@gmail.com> | 2022-02-24 16:10:33 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-02-25 21:14:04 -0500 |
| commit | ac9f460622b69bbd2fef3f08c0a876de226bc496 (patch) | |
| tree | 36a99570654ec4af380ced922846c6522c98ca67 | |
| parent | 140438a81be65d068f555788c4da2ce32182530b (diff) | |
| download | haskell-ac9f460622b69bbd2fef3f08c0a876de226bc496.tar.gz | |
Allow qualified names in COMPLETE pragmas
The parser didn't allow qualified constructor names to appear
in COMPLETE pragmas. This patch fixes that.
Fixes #20551
| -rw-r--r-- | compiler/GHC/Parser.y | 7 | ||||
| -rw-r--r-- | testsuite/tests/parser/should_compile/T20551.hs | 13 | ||||
| -rw-r--r-- | testsuite/tests/parser/should_compile/all.T | 4 |
3 files changed, 22 insertions, 2 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 3918c752b9..a11a438d89 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -2563,7 +2563,7 @@ sigdecl :: { LHsDecl GhcPs } | pattern_synonym_sig { sL1 $1 . SigD noExtField . unLoc $ $1 } - | '{-# COMPLETE' con_list opt_tyconsig '#-}' + | '{-# COMPLETE' qcon_list opt_tyconsig '#-}' {% let (dcolon, tc) = $3 in acsA (\cs -> sLL $1 $> @@ -3524,6 +3524,11 @@ con_list : con { sL1N $1 [$1] } | con ',' con_list {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} +qcon_list :: { Located [LocatedN RdrName] } +qcon_list : qcon { sL1N $1 [$1] } + | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) + ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + -- See Note [ExplicitTuple] in GHC.Hs.Expr sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors : '(' ')' {% amsrn (sLL $1 $> unitDataCon) (NameAnnOnly NameParens (glAA $1) (glAA $2) []) } diff --git a/testsuite/tests/parser/should_compile/T20551.hs b/testsuite/tests/parser/should_compile/T20551.hs new file mode 100644 index 0000000000..62c672c2f0 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T20551.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} + +module T20551 where + +{-# COMPLETE T, Prelude.False #-} +pattern T :: Bool +pattern T <- True where + T = True + +foo :: Bool -> Bool +foo T = False +foo False = True diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index 8820d7545a..21787b3794 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -181,4 +181,6 @@ test('T20186', normal, compile, ['']) test('T20452', normal, compile, ['']) test('DumpSemis', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast']) -test('T20846', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast'])
\ No newline at end of file +test('T20846', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast']) + +test('T20551', normal, compile, ['']) |