diff options
-rw-r--r-- | compiler/typecheck/TcSplice.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/th/T17305.hs | 16 | ||||
-rw-r--r-- | testsuite/tests/th/T17305.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/th/all.T | 1 |
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, ['']) |