summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-03-31 13:31:37 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-02 01:50:36 -0400
commit30a63e79c65b023497af4fe2347149382c71829d (patch)
tree581691ff95abe35df3bf26859eebb59dfe5db937 /testsuite
parent4980200255dabf59ae537f10c55d19ef1a00bbdd (diff)
downloadhaskell-30a63e79c65b023497af4fe2347149382c71829d.tar.gz
Fix two ASSERT buglets in reifyDataCon
Two `ASSERT`s in `reifyDataCon` were always using `arg_tys`, but `arg_tys` is not meaningful for GADT constructors. In fact, it's worse than non-meaningful, since using `arg_tys` when reifying a GADT constructor can lead to failed `ASSERT`ions, as #17305 demonstrates. This patch applies the simplest possible fix to the immediate problem. The `ASSERT`s now use `r_arg_tys` instead of `arg_tys`, as the former makes sure to give something meaningful for GADT constructors. This makes the panic go away at the very least. There is still an underlying issue with the way the internals of `reifyDataCon` work, as described in https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227023, but we leave that as future work, since fixing the underlying issue is much trickier (see https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227087).
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/th/T17305.hs16
-rw-r--r--testsuite/tests/th/T17305.stderr3
-rw-r--r--testsuite/tests/th/all.T1
3 files changed, 20 insertions, 0 deletions
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, [''])