summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/typecheck/TcSplice.hs4
-rw-r--r--testsuite/tests/th/T17305.hs16
-rw-r--r--testsuite/tests/th/T17305.stderr3
-rw-r--r--testsuite/tests/th/all.T1
4 files changed, 22 insertions, 2 deletions
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 40e16d1305..df32401bc7 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1769,7 +1769,7 @@ reifyDataCon isGadtDataCon tys dc
-- constructors can be declared infix.
-- See Note [Infix GADT constructors] in TcTyClsDecls.
| dataConIsInfix dc && not isGadtDataCon ->
- ASSERT( arg_tys `lengthIs` 2 ) do
+ ASSERT( r_arg_tys `lengthIs` 2 ) do
{ let [r_a1, r_a2] = r_arg_tys
[s1, s2] = dcdBangs
; return $ TH.InfixC (s1,r_a1) name (s2,r_a2) }
@@ -1788,7 +1788,7 @@ reifyDataCon isGadtDataCon tys dc
{ cxt <- reifyCxt theta'
; ex_tvs'' <- reifyTyVars ex_tvs'
; return (TH.ForallC ex_tvs'' cxt main_con) }
- ; ASSERT( arg_tys `equalLength` dcdBangs )
+ ; ASSERT( r_arg_tys `equalLength` dcdBangs )
ret_con }
{-
diff --git a/testsuite/tests/th/T17305.hs b/testsuite/tests/th/T17305.hs
new file mode 100644
index 0000000000..f7cc4cbcb0
--- /dev/null
+++ b/testsuite/tests/th/T17305.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+module T17305 where
+
+import Data.Kind
+import Language.Haskell.TH hiding (Type)
+import System.IO
+
+data family Foo a
+data instance Foo :: Type -> Type where
+ MkFoo :: Foo a
+
+$(do i <- reify ''Foo
+ runIO $ hPutStrLn stderr $ pprint i
+ pure [])
diff --git a/testsuite/tests/th/T17305.stderr b/testsuite/tests/th/T17305.stderr
new file mode 100644
index 0000000000..89618291ef
--- /dev/null
+++ b/testsuite/tests/th/T17305.stderr
@@ -0,0 +1,3 @@
+data family T17305.Foo (a_0 :: *) :: *
+data instance T17305.Foo where
+ T17305.MkFoo :: forall (a_1 :: *) . T17305.Foo a_1
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 690270d732..127bdf665c 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -492,6 +492,7 @@ test('T16980a', normal, compile_fail, [''])
test('T17270a', extra_files(['T17270.hs']), multimod_compile, ['T17270', '-v0'])
test('T17270b', extra_files(['T17270.hs']), multimod_compile, ['T17270', '-fenable-th-splice-warnings -v0'])
test('T17296', normal, compile, ['-v0'])
+test('T17305', normal, compile, ['-v0'])
test('T17380', normal, compile_fail, [''])
test('T17394', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T17379a', normal, compile_fail, [''])