[commit: ghc] master: Raise parse error for `data T where`. (8936ab6)
git at git.haskell.org
git at git.haskell.org
Tue Feb 13 22:49:59 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/8936ab69d18669bab3ca4edf40458f88ae5903f0/ghc
>---------------------------------------------------------------
commit 8936ab69d18669bab3ca4edf40458f88ae5903f0
Author: HE, Tao <sighingnow at gmail.com>
Date: Mon Feb 12 19:55:41 2018 -0500
Raise parse error for `data T where`.
Empty GADTs data declarations can't be identified in type checker. This
patch adds additional checks in parser and raise a parse error when
encounter empty GADTs declarations but extension `GADTs` is not enabled.
Only empty declarations are checked in parser to avoid affecting
existing
error messages related to missing GADTs extension.
This patch should fix issue 8258.
Signed-off-by: HE, Tao <sighingnow at gmail.com>
Test Plan: make test TEST="T8258 T8258NoGADTs"
Reviewers: bgamari, mpickering, alanz, RyanGlScott
Reviewed By: bgamari, RyanGlScott
Subscribers: adamse, RyanGlScott, rwbarton, thomie, mpickering, carter
GHC Trac Issues: #8258
Differential Revision: https://phabricator.haskell.org/D4350
>---------------------------------------------------------------
8936ab69d18669bab3ca4edf40458f88ae5903f0
compiler/parser/Parser.y | 19 +++++++++++--------
compiler/parser/RdrHsSyn.hs | 16 ++++++++++++++++
docs/users_guide/8.6.1-notes.rst | 8 ++++++++
testsuite/tests/parser/should_compile/T8258.hs | 5 +++++
testsuite/tests/parser/should_compile/all.T | 1 +
testsuite/tests/parser/should_fail/T8258NoGADTs.hs | 3 +++
.../tests/parser/should_fail/T8258NoGADTs.stderr | 5 +++++
testsuite/tests/parser/should_fail/all.T | 1 +
testsuite/tests/polykinds/T11640.hs | 2 +-
testsuite/tests/typecheck/should_compile/tc247.hs | 2 +-
10 files changed, 52 insertions(+), 10 deletions(-)
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 7f1a725..898ed3c 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -2087,14 +2087,17 @@ both become a HsTyVar ("Zero", DataName) after the renamer.
gadt_constrlist :: { Located ([AddAnn]
,[LConDecl GhcPs]) } -- Returned in order
- : 'where' '{' gadt_constrs '}' { L (comb2 $1 $3)
- ([mj AnnWhere $1
- ,moc $2
- ,mcc $4]
- , unLoc $3) }
- | 'where' vocurly gadt_constrs close { L (comb2 $1 $3)
- ([mj AnnWhere $1]
- , unLoc $3) }
+
+ : 'where' '{' gadt_constrs '}' {% checkEmptyGADTs $
+ L (comb2 $1 $3)
+ ([mj AnnWhere $1
+ ,moc $2
+ ,mcc $4]
+ , unLoc $3) }
+ | 'where' vocurly gadt_constrs close {% checkEmptyGADTs $
+ L (comb2 $1 $3)
+ ([mj AnnWhere $1]
+ , unLoc $3) }
| {- empty -} { noLoc ([],[]) }
gadt_constrs :: { Located [LConDecl GhcPs] }
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 357d224..6ac6cbc 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -55,6 +55,7 @@ module RdrHsSyn (
checkValSigLhs,
checkDoAndIfThenElse,
checkRecordSyntax,
+ checkEmptyGADTs,
parseErrorSDoc, hintBangPat,
splitTilde, splitTildeApps,
@@ -783,6 +784,21 @@ checkRecordSyntax lr@(L loc r)
(text "Illegal record syntax (use TraditionalRecordSyntax):" <+>
ppr r)
+-- | Check if the gadt_constrlist is empty. Only raise parse error for
+-- `data T where` to avoid affecting existing error message, see #8258.
+checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])
+ -> P (Located ([AddAnn], [LConDecl GhcPs]))
+checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration.
+ = do opts <- fmap options getPState
+ if LangExt.GADTSyntax `extopt` opts -- GADTs implies GADTSyntax
+ then return gadts
+ else parseErrorSDoc span $ vcat
+ [ text "Illegal keyword 'where' in data declaration"
+ , text "Perhaps you intended to use GADTs or a similar language"
+ , text "extension to enable syntax: data T where"
+ ]
+checkEmptyGADTs gadts = return gadts -- Ordinary GADT declaration.
+
checkTyClHdr :: Bool -- True <=> class header
-- False <=> type header
-> LHsType GhcPs
diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst
index e844ab6..8f7e961 100644
--- a/docs/users_guide/8.6.1-notes.rst
+++ b/docs/users_guide/8.6.1-notes.rst
@@ -22,6 +22,14 @@ Full details
Language
~~~~~~~~
+- Data declarations with empty ``where`` clauses are no longer valid without the
+ extension :extension:`GADTSyntax` enabled. For instance, consider the
+ following, ::
+
+ data T where
+
+ The grammar is invalid in Haskell2010. Previously it could be compiled successfully
+ without ``GADTs``. As of GHC 8.6.1, this is a parse error.
Compiler
~~~~~~~~
diff --git a/testsuite/tests/parser/should_compile/T8258.hs b/testsuite/tests/parser/should_compile/T8258.hs
new file mode 100644
index 0000000..18d6483
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T8258.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE GADTs #-}
+
+module T8258 where
+
+data T where
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index cc97710..1ca6d7e 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -100,6 +100,7 @@ test('T7118', normal, compile, [''])
test('T7776', normal, compile, [''])
test('RdrNoStaticPointers01', [], compile, [''])
test('T5682', normal, compile, [''])
+test('T8258', normal, compile, [''])
test('T9723a', normal, compile, [''])
test('T9723b', normal, compile, [''])
test('T10188', normal, compile, [''])
diff --git a/testsuite/tests/parser/should_fail/T8258NoGADTs.hs b/testsuite/tests/parser/should_fail/T8258NoGADTs.hs
new file mode 100644
index 0000000..1080233
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T8258NoGADTs.hs
@@ -0,0 +1,3 @@
+module T8258NoGADTs where
+
+data T where
diff --git a/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr b/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr
new file mode 100644
index 0000000..35f5306
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr
@@ -0,0 +1,5 @@
+
+T8258NoGADTs.hs:3:8: error:
+ Illegal keyword 'where' in data declaration
+ Perhaps you intended to use GADTs or a similar language
+ extension to enable syntax: data T where
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index ef47ed3..2cb9c49 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -87,6 +87,7 @@ test('T5425', normal, compile_fail, [''])
test('T984', normal, compile_fail, [''])
test('T7848', normal, compile_fail, ['-dppr-user-length=100'])
test('ExportCommaComma', normal, compile_fail, [''])
+test('T8258NoGADTs', normal, compile_fail, [''])
test('T8430', literate, compile_fail, [''])
test('T8431', compile_timeout_multiplier(0.05),
compile_fail, ['-XAlternativeLayoutRule'])
diff --git a/testsuite/tests/polykinds/T11640.hs b/testsuite/tests/polykinds/T11640.hs
index 16d9f7c..bbb4a53 100644
--- a/testsuite/tests/polykinds/T11640.hs
+++ b/testsuite/tests/polykinds/T11640.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes, TypeInType #-}
+{-# LANGUAGE GADTs, RankNTypes, TypeInType #-}
module T11640 where
diff --git a/testsuite/tests/typecheck/should_compile/tc247.hs b/testsuite/tests/typecheck/should_compile/tc247.hs
index 0f017a0..abfc9ac 100644
--- a/testsuite/tests/typecheck/should_compile/tc247.hs
+++ b/testsuite/tests/typecheck/should_compile/tc247.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE EmptyDataDecls, KindSignatures #-}
+{-# LANGUAGE GADTs, EmptyDataDecls, KindSignatures #-}
module ShouldCompile where
More information about the ghc-commits
mailing list