6 files changed, 129 insertions, 0 deletions
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', ''])