Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7ba31b7bfd0d4c3aaa1723cf357a0a5cff9fdf65 >--------------------------------------------------------------- commit 7ba31b7bfd0d4c3aaa1723cf357a0a5cff9fdf65 Author: Simon Peyton Jones <[email protected]> Date: Thu Jun 16 23:05:01 2011 +0100 Test Trac #5037 >--------------------------------------------------------------- tests/ghc-regress/th/T5037.hs | 11 +++++++++++ tests/ghc-regress/th/T5037.stderr | 3 +++ tests/ghc-regress/th/all.T | 1 + 3 files changed, 15 insertions(+), 0 deletions(-) diff --git a/tests/ghc-regress/th/T5037.hs b/tests/ghc-regress/th/T5037.hs new file mode 100644 index 0000000..06f42ab --- /dev/null +++ b/tests/ghc-regress/th/T5037.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} +module T5037 where +import Language.Haskell.TH +import System.IO + +$( do ds <- [d| f :: Maybe Int -> Int + f Nothing = 3 + f (Just x) = $(varE (mkName "x")) + |] + runIO $ (putStrLn (pprint ds) >> hFlush stdout) + return ds ) diff --git a/tests/ghc-regress/th/T5037.stderr b/tests/ghc-regress/th/T5037.stderr new file mode 100644 index 0000000..987d7fd --- /dev/null +++ b/tests/ghc-regress/th/T5037.stderr @@ -0,0 +1,3 @@ +f :: Data.Maybe.Maybe GHC.Types.Int -> GHC.Types.Int +f (Data.Maybe.Nothing) = 3 +f (Data.Maybe.Just x_0) = x diff --git a/tests/ghc-regress/th/all.T b/tests/ghc-regress/th/all.T index 48e14cb..47ac833 100644 --- a/tests/ghc-regress/th/all.T +++ b/tests/ghc-regress/th/all.T @@ -180,3 +180,4 @@ 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']) +test('T5037', normal, compile, ['-v0']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
