Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ec748e3dde764f49fa1e4b6e847f88ce40088598 >--------------------------------------------------------------- commit ec748e3dde764f49fa1e4b6e847f88ce40088598 Author: Simon Peyton Jones <[email protected]> Date: Sat Jun 11 16:37:26 2011 +0100 Test Trac #5217 >--------------------------------------------------------------- tests/ghc-regress/th/T5217.hs | 11 +++++++++++ tests/ghc-regress/th/T5217.stderr | 14 ++++++++++++++ tests/ghc-regress/th/all.T | 1 + 3 files changed, 26 insertions(+), 0 deletions(-) diff --git a/tests/ghc-regress/th/T5217.hs b/tests/ghc-regress/th/T5217.hs new file mode 100644 index 0000000..9dd1f1c --- /dev/null +++ b/tests/ghc-regress/th/T5217.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} + +module T5217 where +import Language.Haskell.TH + +$([d| data T a b where { T1 :: Int -> T Int Char + ; T2 :: a -> T a a + ; T3 :: a -> T [a] a + ; T4 :: a -> b -> T b [a] } |]) + + diff --git a/tests/ghc-regress/th/T5217.stderr b/tests/ghc-regress/th/T5217.stderr new file mode 100644 index 0000000..891bb7f --- /dev/null +++ b/tests/ghc-regress/th/T5217.stderr @@ -0,0 +1,14 @@ +T5217.hs:1:1: Splicing declarations + [d| data T a b + where + T1 :: Int -> T Int Char + T2 :: a -> T a a + T3 :: a -> T [a] a + T4 :: a -> b -> T b [a] |] + ======> + T5217.hs:(6,3)-(9,53) + data T a b + = (b ~ Char, a ~ Int) => T1 Int | + b ~ a => T2 a | + a ~ [b] => T3 b | + forall a. b ~ [a] => T4 a a diff --git a/tests/ghc-regress/th/all.T b/tests/ghc-regress/th/all.T index aa96bc6..48e14cb 100644 --- a/tests/ghc-regress/th/all.T +++ b/tests/ghc-regress/th/all.T @@ -179,3 +179,4 @@ test('TH_viewPatPrint', normal, compile_and_run, ['']) test('T4436', normal, compile, ['-v0 -ddump-splices']) test('T4949', normal, compile, ['-v0']) test('T5126', normal, compile, ['-v0']) +test('T5217', normal, compile, ['-v0 -dsuppress-uniques -ddump-splices']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
