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@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

10 files changed, 52 insertions, 10 deletions

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 7f1a725b6b..898ed3c5ae 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 357d22438a..6ac6cbc974 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 e844ab6b2a..8f7e961b4f 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 0000000000..18d6483973
--- /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 cc9771087f..1ca6d7ebad 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 0000000000..1080233bcd
--- /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 0000000000..35f5306274
--- /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 ef47ed3394..2cb9c49de2 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 16d9f7ccff..bbb4a53bfc 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 0f017a02db..abfc9ac9a4 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