diff options
Diffstat (limited to 'testsuite/tests/quasiquotation')
44 files changed, 456 insertions, 0 deletions
diff --git a/testsuite/tests/quasiquotation/Makefile b/testsuite/tests/quasiquotation/Makefile new file mode 100644 index 0000000000..8e2e7e7c78 --- /dev/null +++ b/testsuite/tests/quasiquotation/Makefile @@ -0,0 +1,11 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: T4150 + +T4150: + $(RM) T4150A.hi T4150A.o T4150.hi T4150.o + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T4150A.hs + -'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T4150.hs + diff --git a/testsuite/tests/quasiquotation/T3953.hs b/testsuite/tests/quasiquotation/T3953.hs new file mode 100644 index 0000000000..2b17419201 --- /dev/null +++ b/testsuite/tests/quasiquotation/T3953.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE QuasiQuotes #-} + +module T3953 where + +foo = [notDefinedHere| |] + diff --git a/testsuite/tests/quasiquotation/T3953.stderr b/testsuite/tests/quasiquotation/T3953.stderr new file mode 100644 index 0000000000..da6f2dcebf --- /dev/null +++ b/testsuite/tests/quasiquotation/T3953.stderr @@ -0,0 +1,2 @@ + +T3953.hs:5:7: Not in scope: `notDefinedHere' diff --git a/testsuite/tests/quasiquotation/T4150.hs b/testsuite/tests/quasiquotation/T4150.hs new file mode 100644 index 0000000000..3bf7cddc49 --- /dev/null +++ b/testsuite/tests/quasiquotation/T4150.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP, QuasiQuotes #-} + +module Main (main) where + +import T4150A + +myHtmlsTemplate = [multiLineStr| +#include "T4150template.txt" +|] + +somethingElse :: NoSuchType +somethingElse = undefined + +main :: IO () +main = print myHtmlsTemplate + diff --git a/testsuite/tests/quasiquotation/T4150.stderr b/testsuite/tests/quasiquotation/T4150.stderr new file mode 100644 index 0000000000..9e0f4c26ab --- /dev/null +++ b/testsuite/tests/quasiquotation/T4150.stderr @@ -0,0 +1,3 @@ + +T4150.hs:11:18: + Not in scope: type constructor or class `NoSuchType' diff --git a/testsuite/tests/quasiquotation/T4150A.hs b/testsuite/tests/quasiquotation/T4150A.hs new file mode 100644 index 0000000000..25ee003fee --- /dev/null +++ b/testsuite/tests/quasiquotation/T4150A.hs @@ -0,0 +1,13 @@ + +module T4150A where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote + +multiLineStr :: QuasiQuoter +multiLineStr = QuasiQuoter { + quoteExp = stringE, + quotePat = error "XXX", + quoteType = error "XXX", + quoteDec = error "XXX" + } diff --git a/testsuite/tests/quasiquotation/T4150template.txt b/testsuite/tests/quasiquotation/T4150template.txt new file mode 100644 index 0000000000..a92d664bc2 --- /dev/null +++ b/testsuite/tests/quasiquotation/T4150template.txt @@ -0,0 +1,3 @@ +line 1 +line 2 +line 3 diff --git a/testsuite/tests/quasiquotation/all.T b/testsuite/tests/quasiquotation/all.T new file mode 100644 index 0000000000..2fa0427813 --- /dev/null +++ b/testsuite/tests/quasiquotation/all.T @@ -0,0 +1,7 @@ +test('T3953', [req_interp, only_compiler_types(['ghc'])], compile_fail, ['']) +test('T4150', + [only_compiler_types(['ghc']), + expect_broken(4150), + extra_clean(['T4150A.hi', 'T4150A.o', 'T4150.hi', 'T4150.o'])], + run_command, + ['$MAKE -s --no-print-directory T4150']) diff --git a/testsuite/tests/quasiquotation/qq001/Makefile b/testsuite/tests/quasiquotation/qq001/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq001/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/quasiquotation/qq001/qq001.hs b/testsuite/tests/quasiquotation/qq001/qq001.hs new file mode 100644 index 0000000000..652c8cf874 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq001/qq001.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE QuasiQuotes #-} +module Main where + +parse = undefined + +main :: IO () +main = print $ [parse||] diff --git a/testsuite/tests/quasiquotation/qq001/qq001.stderr b/testsuite/tests/quasiquotation/qq001/qq001.stderr new file mode 100644 index 0000000000..aa748e60cd --- /dev/null +++ b/testsuite/tests/quasiquotation/qq001/qq001.stderr @@ -0,0 +1,4 @@ + +qq001.hs:7:16: + GHC stage restriction: parse + is used in a quasiquote, and must be imported, not defined locally diff --git a/testsuite/tests/quasiquotation/qq001/test.T b/testsuite/tests/quasiquotation/qq001/test.T new file mode 100644 index 0000000000..2db7546687 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq001/test.T @@ -0,0 +1,2 @@ +test('qq001', [req_interp, only_compiler_types(['ghc'])], + compile_fail, ['']) diff --git a/testsuite/tests/quasiquotation/qq002/Makefile b/testsuite/tests/quasiquotation/qq002/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq002/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/quasiquotation/qq002/qq002.hs b/testsuite/tests/quasiquotation/qq002/qq002.hs new file mode 100644 index 0000000000..a9ac995e5a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq002/qq002.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE QuasiQuotes #-} +module Main where + +parse = undefined + +main :: IO () +main = case () of + [parse||] -> return () + _ -> return () diff --git a/testsuite/tests/quasiquotation/qq002/qq002.stderr b/testsuite/tests/quasiquotation/qq002/qq002.stderr new file mode 100644 index 0000000000..b32b5ac6a0 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq002/qq002.stderr @@ -0,0 +1,4 @@ + +qq002.hs:8:10: + GHC stage restriction: parse + is used in a quasiquote, and must be imported, not defined locally diff --git a/testsuite/tests/quasiquotation/qq002/test.T b/testsuite/tests/quasiquotation/qq002/test.T new file mode 100644 index 0000000000..2c39664a85 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq002/test.T @@ -0,0 +1,2 @@ +test('qq002', [req_interp, only_compiler_types(['ghc'])], + compile_fail, ['']) diff --git a/testsuite/tests/quasiquotation/qq003/Makefile b/testsuite/tests/quasiquotation/qq003/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq003/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/quasiquotation/qq003/qq003.hs b/testsuite/tests/quasiquotation/qq003/qq003.hs new file mode 100644 index 0000000000..7afbad964e --- /dev/null +++ b/testsuite/tests/quasiquotation/qq003/qq003.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE QuasiQuotes #-} +module Main where + +main :: IO () +main = print $ \parse -> [parse||] diff --git a/testsuite/tests/quasiquotation/qq003/qq003.stderr b/testsuite/tests/quasiquotation/qq003/qq003.stderr new file mode 100644 index 0000000000..a1f490fb2c --- /dev/null +++ b/testsuite/tests/quasiquotation/qq003/qq003.stderr @@ -0,0 +1,4 @@ + +qq003.hs:5:26: + GHC stage restriction: parse + is used in a quasiquote, and must be imported, not defined locally diff --git a/testsuite/tests/quasiquotation/qq003/test.T b/testsuite/tests/quasiquotation/qq003/test.T new file mode 100644 index 0000000000..9c61d0a11a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq003/test.T @@ -0,0 +1,2 @@ +test('qq003', [req_interp, only_compiler_types(['ghc'])], + compile_fail, ['']) diff --git a/testsuite/tests/quasiquotation/qq004/Makefile b/testsuite/tests/quasiquotation/qq004/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq004/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/quasiquotation/qq004/qq004.hs b/testsuite/tests/quasiquotation/qq004/qq004.hs new file mode 100644 index 0000000000..c95b94ef02 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq004/qq004.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE QuasiQuotes #-} +module Main where + +main :: IO () +main = p undefined + where + p = \parse -> case () of + [parse||] -> return () + _ -> return () diff --git a/testsuite/tests/quasiquotation/qq004/qq004.stderr b/testsuite/tests/quasiquotation/qq004/qq004.stderr new file mode 100644 index 0000000000..be61788926 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq004/qq004.stderr @@ -0,0 +1,4 @@ + +qq004.hs:8:21: + GHC stage restriction: parse + is used in a quasiquote, and must be imported, not defined locally diff --git a/testsuite/tests/quasiquotation/qq004/test.T b/testsuite/tests/quasiquotation/qq004/test.T new file mode 100644 index 0000000000..13ecda5dad --- /dev/null +++ b/testsuite/tests/quasiquotation/qq004/test.T @@ -0,0 +1,2 @@ +test('qq004', [req_interp, only_compiler_types(['ghc'])], + compile_fail, ['']) diff --git a/testsuite/tests/quasiquotation/qq005/Expr.hs b/testsuite/tests/quasiquotation/qq005/Expr.hs new file mode 100644 index 0000000000..d628e8d52f --- /dev/null +++ b/testsuite/tests/quasiquotation/qq005/Expr.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Expr where + +import Data.Generics +import Language.Haskell.TH as TH +import Language.Haskell.TH.Quote + +import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec.Char + +data Expr = IntExpr Integer + | AntiIntExpr String + | BinopExpr BinOp Expr Expr + | AntiExpr String + deriving(Typeable, Data) + +data BinOp = AddOp + | SubOp + | MulOp + | DivOp + deriving(Typeable, Data) + +eval :: Expr -> Integer +eval (IntExpr n) = n +eval (BinopExpr op x y) = (opToFun op) (eval x) (eval y) + where + opToFun AddOp = (+) + opToFun SubOp = (-) + opToFun MulOp = (*) + opToFun DivOp = (div) + +small = lower <|> char '_' +large = upper +idchar = small <|> large <|> digit <|> char '\'' + +lexeme p = do{ x <- p; spaces; return x } +symbol name = lexeme (string name) +parens p = between (symbol "(") (symbol ")") p + +_expr :: CharParser st Expr +_expr = term `chainl1` mulop + +term :: CharParser st Expr +term = factor `chainl1` addop + +factor :: CharParser st Expr +factor = parens _expr <|> integer <|> anti + +mulop = do{ symbol "*"; return $ BinopExpr MulOp } + <|> do{ symbol "/"; return $ BinopExpr DivOp } + +addop = do{ symbol "+"; return $ BinopExpr AddOp } + <|> do{ symbol "-"; return $ BinopExpr SubOp } + +integer :: CharParser st Expr +integer = lexeme $ do{ ds <- many1 digit ; return $ IntExpr (read ds) } + +anti = lexeme $ + do symbol "$" + c <- small + cs <- many idchar + return $ AntiIntExpr (c : cs) + +parseExpr :: Monad m => TH.Loc -> String -> m Expr +parseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s = + case runParser p () "" s of + Left err -> fail $ show err + Right e -> return e + where + p = do pos <- getPosition + setPosition $ setSourceName (setSourceLine (setSourceColumn pos col) line) file + spaces + e <- _expr + eof + return e + +expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat } + +parseExprExp :: String -> Q Exp +parseExprExp s = do loc <- location + expr <- parseExpr loc s + dataToExpQ (const Nothing `extQ` antiExprExp) expr + +antiExprExp :: Expr -> Maybe (Q Exp) +antiExprExp (AntiIntExpr v) = Just $ appE (conE (mkName "IntExpr")) + (varE (mkName v)) +antiExprExp (AntiExpr v) = Just $ varE (mkName v) +antiExprExp _ = Nothing + +parseExprPat :: String -> Q Pat +parseExprPat s = do loc <- location + expr <- parseExpr loc s + dataToPatQ (const Nothing `extQ` antiExprPat) expr + +antiExprPat :: Expr -> Maybe (Q Pat) +antiExprPat (AntiIntExpr v) = Just $ conP (mkName "IntExpr") + [varP (mkName v)] +antiExprPat (AntiExpr v) = Just $ varP (mkName v) +antiExprPat _ = Nothing diff --git a/testsuite/tests/quasiquotation/qq005/Main.hs b/testsuite/tests/quasiquotation/qq005/Main.hs new file mode 100644 index 0000000000..d8c8a3433c --- /dev/null +++ b/testsuite/tests/quasiquotation/qq005/Main.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE QuasiQuotes #-} +module Main where + +import Expr + +main :: IO () +main = do print $ eval [expr|1 + 3 + 5|] + case [expr|2|] of + [expr|$n|] -> print n + _ -> return () + case [$expr|1 + 2|] of + [expr|$x + $y|] -> putStrLn $ show x ++ " + " ++ show y + _ -> return () diff --git a/testsuite/tests/quasiquotation/qq005/Makefile b/testsuite/tests/quasiquotation/qq005/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq005/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/quasiquotation/qq005/qq005.stderr b/testsuite/tests/quasiquotation/qq005/qq005.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq005/qq005.stderr diff --git a/testsuite/tests/quasiquotation/qq005/qq005.stdout b/testsuite/tests/quasiquotation/qq005/qq005.stdout new file mode 100644 index 0000000000..b9473d1e3b --- /dev/null +++ b/testsuite/tests/quasiquotation/qq005/qq005.stdout @@ -0,0 +1,3 @@ +9 +2 +1 + 2 diff --git a/testsuite/tests/quasiquotation/qq005/test.T b/testsuite/tests/quasiquotation/qq005/test.T new file mode 100644 index 0000000000..52671ef838 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq005/test.T @@ -0,0 +1,11 @@ +test('qq005', + [skip_if_fast, + reqlib('parsec'), + only_compiler_types(['ghc']), + # We'd need to jump through some hoops to run this test the + # profiling ways, due to the TH use, so for now we just + # omit the profiling ways + omit_ways(['profasm','profthreaded']), + extra_clean(['Expr.hi', 'Expr.o', 'Main.hi', 'Main.o'])], + multimod_compile_and_run, + ['Main', '']) diff --git a/testsuite/tests/quasiquotation/qq006/Expr.hs b/testsuite/tests/quasiquotation/qq006/Expr.hs new file mode 100644 index 0000000000..d628e8d52f --- /dev/null +++ b/testsuite/tests/quasiquotation/qq006/Expr.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Expr where + +import Data.Generics +import Language.Haskell.TH as TH +import Language.Haskell.TH.Quote + +import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec.Char + +data Expr = IntExpr Integer + | AntiIntExpr String + | BinopExpr BinOp Expr Expr + | AntiExpr String + deriving(Typeable, Data) + +data BinOp = AddOp + | SubOp + | MulOp + | DivOp + deriving(Typeable, Data) + +eval :: Expr -> Integer +eval (IntExpr n) = n +eval (BinopExpr op x y) = (opToFun op) (eval x) (eval y) + where + opToFun AddOp = (+) + opToFun SubOp = (-) + opToFun MulOp = (*) + opToFun DivOp = (div) + +small = lower <|> char '_' +large = upper +idchar = small <|> large <|> digit <|> char '\'' + +lexeme p = do{ x <- p; spaces; return x } +symbol name = lexeme (string name) +parens p = between (symbol "(") (symbol ")") p + +_expr :: CharParser st Expr +_expr = term `chainl1` mulop + +term :: CharParser st Expr +term = factor `chainl1` addop + +factor :: CharParser st Expr +factor = parens _expr <|> integer <|> anti + +mulop = do{ symbol "*"; return $ BinopExpr MulOp } + <|> do{ symbol "/"; return $ BinopExpr DivOp } + +addop = do{ symbol "+"; return $ BinopExpr AddOp } + <|> do{ symbol "-"; return $ BinopExpr SubOp } + +integer :: CharParser st Expr +integer = lexeme $ do{ ds <- many1 digit ; return $ IntExpr (read ds) } + +anti = lexeme $ + do symbol "$" + c <- small + cs <- many idchar + return $ AntiIntExpr (c : cs) + +parseExpr :: Monad m => TH.Loc -> String -> m Expr +parseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s = + case runParser p () "" s of + Left err -> fail $ show err + Right e -> return e + where + p = do pos <- getPosition + setPosition $ setSourceName (setSourceLine (setSourceColumn pos col) line) file + spaces + e <- _expr + eof + return e + +expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat } + +parseExprExp :: String -> Q Exp +parseExprExp s = do loc <- location + expr <- parseExpr loc s + dataToExpQ (const Nothing `extQ` antiExprExp) expr + +antiExprExp :: Expr -> Maybe (Q Exp) +antiExprExp (AntiIntExpr v) = Just $ appE (conE (mkName "IntExpr")) + (varE (mkName v)) +antiExprExp (AntiExpr v) = Just $ varE (mkName v) +antiExprExp _ = Nothing + +parseExprPat :: String -> Q Pat +parseExprPat s = do loc <- location + expr <- parseExpr loc s + dataToPatQ (const Nothing `extQ` antiExprPat) expr + +antiExprPat :: Expr -> Maybe (Q Pat) +antiExprPat (AntiIntExpr v) = Just $ conP (mkName "IntExpr") + [varP (mkName v)] +antiExprPat (AntiExpr v) = Just $ varP (mkName v) +antiExprPat _ = Nothing diff --git a/testsuite/tests/quasiquotation/qq006/Main.hs b/testsuite/tests/quasiquotation/qq006/Main.hs new file mode 100644 index 0000000000..7e21acc235 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq006/Main.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE QuasiQuotes #-} +module Main where + +import Expr + +main :: IO () +main = do case [$expr|1 + 2|] of + [$expr|$x + $x|] -> print x + _ -> return () diff --git a/testsuite/tests/quasiquotation/qq006/Makefile b/testsuite/tests/quasiquotation/qq006/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq006/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/quasiquotation/qq006/qq006.stderr b/testsuite/tests/quasiquotation/qq006/qq006.stderr new file mode 100644 index 0000000000..3eb51824b0 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq006/qq006.stderr @@ -0,0 +1,4 @@ + +Main.hs:8:20: + Conflicting definitions for `x' + In a case alternative diff --git a/testsuite/tests/quasiquotation/qq006/test.T b/testsuite/tests/quasiquotation/qq006/test.T new file mode 100644 index 0000000000..21d9a3db1c --- /dev/null +++ b/testsuite/tests/quasiquotation/qq006/test.T @@ -0,0 +1,7 @@ +test('qq006', + [skip_if_fast, + reqlib('parsec'), + extra_clean(['Expr.hi', 'Expr.o']), + only_compiler_types(['ghc'])], + multimod_compile_fail, + ['Main', '-v0']) diff --git a/testsuite/tests/quasiquotation/qq007/Makefile b/testsuite/tests/quasiquotation/qq007/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq007/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/quasiquotation/qq007/QQ.hs b/testsuite/tests/quasiquotation/qq007/QQ.hs new file mode 100644 index 0000000000..3c13315a31 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq007/QQ.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-}
+module QQ where
+
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH
+
+pq = QuasiQuoter { quoteDec = \_ -> [d| f x = x |],
+ quoteType = \_ -> [t| Int -> Int |],
+ quoteExp = \_ -> [| $(varE (mkName "x")) + 1::Int |],
+ quotePat = \_ -> [p| Just x |] }
+
diff --git a/testsuite/tests/quasiquotation/qq007/Test.hs b/testsuite/tests/quasiquotation/qq007/Test.hs new file mode 100644 index 0000000000..42cef722d3 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq007/Test.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE QuasiQuotes #-}
+module Test where
+
+import QQ
+
+f :: [pq| foo |] -- Expands to Int -> Int
+[pq| blah |] -- Expands to f x = x
+
+h [pq| foo |] = f [pq| blah |] * 8
+ -- Expands to h (Just x) = f (x+1) * 8
+
+
+
diff --git a/testsuite/tests/quasiquotation/qq007/test.T b/testsuite/tests/quasiquotation/qq007/test.T new file mode 100644 index 0000000000..6b7ef6dcd7 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq007/test.T @@ -0,0 +1,10 @@ +test('qq007', + [skip_if_fast, + extra_clean(['QQ.hi', 'QQ.o', 'Test.hi', 'Test.o']), + # We'd need to jump through some hoops to run this test the + # profiling ways, due to the TH use, so for now we just + # omit the profiling ways + omit_ways(['profasm','profthreaded']), + only_compiler_types(['ghc'])], + multimod_compile, + ['Test', '-v0']) diff --git a/testsuite/tests/quasiquotation/qq008/Makefile b/testsuite/tests/quasiquotation/qq008/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq008/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/quasiquotation/qq008/QQ.hs b/testsuite/tests/quasiquotation/qq008/QQ.hs new file mode 100644 index 0000000000..eee8dc9670 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq008/QQ.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} +module QQ where + +import Language.Haskell.TH.Quote +import Language.Haskell.TH + +pq = QuasiQuoter { quoteDec = \_ -> [d| f x = x |], + quoteType = \_ -> [t| Int -> Int |], + quoteExp = \_ -> [| $(varE (mkName "x")) + 1::Int |], + quotePat = \_ -> [p| Just x |] } + diff --git a/testsuite/tests/quasiquotation/qq008/Test.hs b/testsuite/tests/quasiquotation/qq008/Test.hs new file mode 100644 index 0000000000..c04f427f63 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq008/Test.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE QuasiQuotes #-} +module Test where + +import QQ + +f :: [pq| foo |] -- Expands to Int -> Int +[pq| blah |] -- Expands to f x = x + +h [pq| foo |] = f [$pq| blah |] * 8 +-- Expands to h (Just x) = f (x+1) * 8 + + + diff --git a/testsuite/tests/quasiquotation/qq008/qq008.stderr b/testsuite/tests/quasiquotation/qq008/qq008.stderr new file mode 100644 index 0000000000..b13e999463 --- /dev/null +++ b/testsuite/tests/quasiquotation/qq008/qq008.stderr @@ -0,0 +1,4 @@ + +Test.hs:9:19: + Warning: Deprecated syntax: + quasiquotes no longer need a dollar sign: $pq diff --git a/testsuite/tests/quasiquotation/qq008/test.T b/testsuite/tests/quasiquotation/qq008/test.T new file mode 100644 index 0000000000..02b88dbd0a --- /dev/null +++ b/testsuite/tests/quasiquotation/qq008/test.T @@ -0,0 +1,10 @@ +test('qq008', + [skip_if_fast, + extra_clean(['QQ.hi', 'QQ.o', 'Test.hi', 'Test.o']), + # We'd need to jump through some hoops to run this test the + # profiling ways, due to the TH use, so for now we just + # omit the profiling ways + omit_ways(['profasm','profthreaded']), + only_compiler_types(['ghc'])], + multimod_compile, + ['Test', '-v0']) |