template-haskell: require at least 1 GADT constructor name (#17379)

compiler/GHC/ThToHs.hs

@@ -600,6 +600,9 @@ cvtConstr (ForallC tvs ctxt con)
 
     add_forall _ _ (XConDecl nec) = noExtCon nec
 
+cvtConstr (GadtC [] _strtys _ty)
+  = failWith (text "GadtC must have at least one constructor name")
+
 cvtConstr (GadtC c strtys ty)
   = do  { c'      <- mapM cNameL c
         ; args    <- mapM cvt_arg strtys
@@ -607,6 +610,9 @@ cvtConstr (GadtC c strtys ty)
         ; c_ty    <- mk_arr_apps args ty'
         ; returnL $ fst $ mkGadtDecl c' c_ty}
 
+cvtConstr (RecGadtC [] _varstrtys _ty)
+  = failWith (text "RecGadtC must have at least one constructor name")
+
 cvtConstr (RecGadtC c varstrtys ty)
   = do  { c'       <- mapM cNameL c
         ; ty'      <- cvtType ty

testsuite/tests/th/T17379a.hs

+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE GADTSyntax #-}
+
+module T17379a where
+
+import Language.Haskell.TH
+
+$(let typ = mkName "T" in pure [ DataD [] typ [] Nothing [GadtC [] [] (ConT typ)] [] ])

testsuite/tests/th/T17379a.stderr

+
+T17379a.hs:8:3:
+    GadtC must have at least one constructor name
+    When splicing a TH declaration: data T where :: T

testsuite/tests/th/T17379b.hs

+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE GADTSyntax #-}
+
+module T17379b where
+
+import Language.Haskell.TH
+
+$(let typ = mkName "T" in pure [ DataD [] typ [] Nothing [RecGadtC [] [] (ConT typ)] [] ])

testsuite/tests/th/T17379b.stderr

+
+T17379b.hs:8:3:
+    RecGadtC must have at least one constructor name
+    When splicing a TH declaration: data T where :: {} -> T

testsuite/tests/th/all.T

@@ -487,3 +487,5 @@ test('T16980', normal, compile, [''])
 test('T16980a', normal, compile_fail, [''])
 test('T17296', normal, compile, ['-v0'])
 test('T17394', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T17379a', normal, compile_fail, [''])
+test('T17379b', normal, compile_fail, [''])