[commit: ghc] master: Testsuite: fix qq005 and qq006 (#11279) (2032635)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2032635b80d8fc34dc168e2c22f51f8a69d97a1c/ghc

>---------------------------------------------------------------

commit 2032635b80d8fc34dc168e2c22f51f8a69d97a1c
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Fri Dec 25 14:10:35 2015 +0100

    Testsuite: fix qq005 and qq006 (#11279)
    
    With 399a5b46591dfbee0499d6afa1bb80ad2fd52598, the old `[$foo| ... |]`
    syntax for quasi-quotes is no longer allowed.


>---------------------------------------------------------------

2032635b80d8fc34dc168e2c22f51f8a69d97a1c
 testsuite/tests/quasiquotation/qq005/Expr.hs      | 20 ++++++++++++++++++--
 testsuite/tests/quasiquotation/qq005/Main.hs      |  6 +++---
 testsuite/tests/quasiquotation/qq006/Expr.hs      | 20 ++++++++++++++++++--
 testsuite/tests/quasiquotation/qq006/Main.hs      |  6 +++---
 testsuite/tests/quasiquotation/qq006/qq006.stderr |  8 +++++---
 5 files changed, 47 insertions(+), 13 deletions(-)

diff --git a/testsuite/tests/quasiquotation/qq005/Expr.hs b/testsuite/tests/quasiquotation/qq005/Expr.hs
index d628e8d..1c51d9d 100644
--- a/testsuite/tests/quasiquotation/qq005/Expr.hs
+++ b/testsuite/tests/quasiquotation/qq005/Expr.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Expr where
 
-import Data.Generics
+import Data.Data
+import Data.Typeable
 import Language.Haskell.TH as TH
 import Language.Haskell.TH.Quote
 
@@ -29,6 +31,7 @@ eval (BinopExpr op x y) = (opToFun op) (eval x) (eval y)
     opToFun MulOp = (*)
     opToFun DivOp = (div)
 
+small :: CharParser st Char
 small   = lower <|> char '_'
 large   = upper
 idchar  = small <|> large <|> digit <|> char '\''
@@ -74,7 +77,8 @@ parseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s =
             eof
             return e
 
-expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat }
+expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat,
+                     quoteType = undefined, quoteDec = undefined }
 
 parseExprExp :: String -> Q Exp
 parseExprExp s =  do  loc <- location
@@ -97,3 +101,15 @@ antiExprPat  (AntiIntExpr v)  = Just $ conP  (mkName "IntExpr")
                                                 [varP (mkName v)]
 antiExprPat  (AntiExpr v)     = Just $ varP  (mkName v)
 antiExprPat  _                = Nothing
+
+-- Copied from syb for the test
+
+-- | Extend a generic query by a type-specific case
+extQ :: ( Typeable a
+        , Typeable b
+        )
+     => (a -> q)
+     -> (b -> q)
+     -> a
+     -> q
+extQ f g a = maybe (f a) g (cast a)
diff --git a/testsuite/tests/quasiquotation/qq005/Main.hs b/testsuite/tests/quasiquotation/qq005/Main.hs
index d8c8a34..7b2de89 100644
--- a/testsuite/tests/quasiquotation/qq005/Main.hs
+++ b/testsuite/tests/quasiquotation/qq005/Main.hs
@@ -7,7 +7,7 @@ main :: IO ()
 main = do  print $ eval [expr|1 + 3 + 5|]
            case [expr|2|] of
              [expr|$n|] -> print n
-             _           -> return ()
-           case [$expr|1 + 2|] of
+             _          -> return ()
+           case [expr|1 + 2|] of
              [expr|$x + $y|] -> putStrLn $ show x ++ " + " ++ show y
-             _                -> return ()
+             _               -> return ()
diff --git a/testsuite/tests/quasiquotation/qq006/Expr.hs b/testsuite/tests/quasiquotation/qq006/Expr.hs
index d628e8d..1c51d9d 100644
--- a/testsuite/tests/quasiquotation/qq006/Expr.hs
+++ b/testsuite/tests/quasiquotation/qq006/Expr.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Expr where
 
-import Data.Generics
+import Data.Data
+import Data.Typeable
 import Language.Haskell.TH as TH
 import Language.Haskell.TH.Quote
 
@@ -29,6 +31,7 @@ eval (BinopExpr op x y) = (opToFun op) (eval x) (eval y)
     opToFun MulOp = (*)
     opToFun DivOp = (div)
 
+small :: CharParser st Char
 small   = lower <|> char '_'
 large   = upper
 idchar  = small <|> large <|> digit <|> char '\''
@@ -74,7 +77,8 @@ parseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s =
             eof
             return e
 
-expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat }
+expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat,
+                     quoteType = undefined, quoteDec = undefined }
 
 parseExprExp :: String -> Q Exp
 parseExprExp s =  do  loc <- location
@@ -97,3 +101,15 @@ antiExprPat  (AntiIntExpr v)  = Just $ conP  (mkName "IntExpr")
                                                 [varP (mkName v)]
 antiExprPat  (AntiExpr v)     = Just $ varP  (mkName v)
 antiExprPat  _                = Nothing
+
+-- Copied from syb for the test
+
+-- | Extend a generic query by a type-specific case
+extQ :: ( Typeable a
+        , Typeable b
+        )
+     => (a -> q)
+     -> (b -> q)
+     -> a
+     -> q
+extQ f g a = maybe (f a) g (cast a)
diff --git a/testsuite/tests/quasiquotation/qq006/Main.hs b/testsuite/tests/quasiquotation/qq006/Main.hs
index 7e21acc..686b849 100644
--- a/testsuite/tests/quasiquotation/qq006/Main.hs
+++ b/testsuite/tests/quasiquotation/qq006/Main.hs
@@ -4,6 +4,6 @@ module Main where
 import Expr
 
 main :: IO ()
-main = do  case [$expr|1 + 2|] of
-             [$expr|$x + $x|] -> print x
-             _                -> return ()
+main = do  case [expr|1 + 2|] of
+             [expr|$x + $x|] -> print x
+             _               -> return ()
diff --git a/testsuite/tests/quasiquotation/qq006/qq006.stderr b/testsuite/tests/quasiquotation/qq006/qq006.stderr
index 3eb5182..3fd0d01 100644
--- a/testsuite/tests/quasiquotation/qq006/qq006.stderr
+++ b/testsuite/tests/quasiquotation/qq006/qq006.stderr
@@ -1,4 +1,6 @@
 
-Main.hs:8:20:
-    Conflicting definitions for `x'
-    In a case alternative
+Main.hs:8:20: error:
+    • Conflicting definitions for ‘x’
+      Bound at: Main.hs:8:20-28
+                Main.hs:8:20-28
+    • In a case alternative