Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/d617e70ac32bd73ab3774f728593b541ff24d5ee >--------------------------------------------------------------- commit d617e70ac32bd73ab3774f728593b541ff24d5ee Author: Paolo Capriotti <[email protected]> Date: Mon Apr 2 13:05:08 2012 +0100 Add testcase for #5555. >--------------------------------------------------------------- tests/th/T5555.hs | 8 ++++++++ .../should_run/conc001.stdout => th/T5555.stdout} | 0 tests/th/T5555_Lib.hs | 10 ++++++++++ tests/th/all.T | 2 ++ 4 files changed, 20 insertions(+), 0 deletions(-) diff --git a/tests/th/T5555.hs b/tests/th/T5555.hs new file mode 100644 index 0000000..a874a73 --- /dev/null +++ b/tests/th/T5555.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes #-} +import qualified T5555_Lib as L + +test :: String +test = [L.s|hello world|] + +main :: IO () +main = putStrLn test diff --git a/tests/concurrent/should_run/conc001.stdout b/tests/th/T5555.stdout similarity index 100% copy from tests/concurrent/should_run/conc001.stdout copy to tests/th/T5555.stdout diff --git a/tests/th/T5555_Lib.hs b/tests/th/T5555_Lib.hs new file mode 100644 index 0000000..66c18d2 --- /dev/null +++ b/tests/th/T5555_Lib.hs @@ -0,0 +1,10 @@ +module T5555_Lib(s) where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote + +s :: QuasiQuoter +s = QuasiQuoter expr undefined undefined undefined + +expr :: String -> Q Exp +expr = stringE diff --git a/tests/th/all.T b/tests/th/all.T index 89b599b..b428fca 100644 --- a/tests/th/all.T +++ b/tests/th/all.T @@ -230,3 +230,5 @@ test('T5971', normal, compile_fail, ['-v0 -dsuppress-uniques']) test('T5968', normal, compile, ['-v0']) test('T5984', extra_clean(['T5984_Lib.hi', 'T5984_Lib.o']), multimod_compile, ['T5984', '-v0 -ddump-splices']) +test('T5555', extra_clean(['T5555_Lib.hi', 'T5555_Lib.o']), + multimod_compile, ['T5555', '-v0']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
