Repository : ssh://g...@git.haskell.org/testsuite On branch : wip/th-new Link : http://ghc.haskell.org/trac/ghc/changeset/bea08b32e368085e02426ea1ae9983147f504349/testsuite
>--------------------------------------------------------------- commit bea08b32e368085e02426ea1ae9983147f504349 Author: Geoffrey Mainland <mainl...@apeiron.net> Date: Thu May 16 15:03:05 2013 +0100 Adjust tests for new Template Haskell. From the new Template Haskell proposal at http://hackage.haskell.org/trac/ghc/blog/Template%20Haskell%20Proposal A declaration group is the chunk of declarations created by a top-level declaration splice, plus those following it, down to but not including the next top-level declaration splice. Then the type environment seen by reify includes all the declaration up to the end of the immediately preceding declaration block, but no more. This change adds '$(return [])' where necessary to allow following declarations to see (module-local) top-level definitions. >--------------------------------------------------------------- bea08b32e368085e02426ea1ae9983147f504349 tests/th/T1835.hs | 2 ++ tests/th/T2222.hs | 6 ++++++ tests/th/T3920.hs | 2 ++ tests/th/T5358.hs | 2 ++ tests/th/T7910.hs | 2 ++ tests/th/TH_lookupName.hs | 2 ++ tests/th/TH_reifyDecl1.hs | 2 ++ tests/th/TH_reifyInstances.hs | 2 ++ tests/th/TH_unresolvedInfix2.hs | 2 ++ 9 files changed, 22 insertions(+) diff --git a/tests/th/T1835.hs b/tests/th/T1835.hs index e2029fa..d0c4dba 100644 --- a/tests/th/T1835.hs +++ b/tests/th/T1835.hs @@ -24,6 +24,8 @@ instance Ord a => MyClass (Quux2 a) class MyClass2 a b instance MyClass2 Int Bool +$(return []) + main = do putStrLn $(do { info <- reify ''MyClass; lift (pprint info) }) print $(isInstance ''Eq [ConT ''Foo] >>= lift) diff --git a/tests/th/T2222.hs b/tests/th/T2222.hs index 9a97c0d..bba9231 100644 --- a/tests/th/T2222.hs +++ b/tests/th/T2222.hs @@ -7,12 +7,16 @@ import System.IO a = 1 +$(return []) + b = $(do VarI _ t _ _ <- reify 'a runIO $ putStrLn ("inside b: " ++ pprint t) [| undefined |]) c = $([| True |]) +$(return []) + d = $(do VarI _ t _ _ <- reify 'c runIO $ putStrLn ("inside d: " ++ pprint t) [| undefined |] ) @@ -23,6 +27,8 @@ $(do VarI _ t _ _ <- reify 'c e = $([| True |]) +$(return []) + f = $(do VarI _ t _ _ <- reify 'e runIO $ putStrLn ("inside f: " ++ pprint t) [| undefined |] ) diff --git a/tests/th/T3920.hs b/tests/th/T3920.hs index 8a8ac0b..4d7ccef 100644 --- a/tests/th/T3920.hs +++ b/tests/th/T3920.hs @@ -5,6 +5,8 @@ import Language.Haskell.TH type family S :: (* -> (* -> * -> *)) -> (* -> *) -> * +$(return []) + test :: String test = $(do test <- [d| diff --git a/tests/th/T5358.hs b/tests/th/T5358.hs index a912b00..6a1d817 100644 --- a/tests/th/T5358.hs +++ b/tests/th/T5358.hs @@ -9,6 +9,8 @@ t2 x = x prop_x1 x = t1 x == t2 x +$(return []) + runTests = $( do VarI _ t _ _ <- reify (mkName "prop_x1") error $ ("runTest called error: " ++ pprint t) ) diff --git a/tests/th/T7910.hs b/tests/th/T7910.hs index d044365..d62afc8 100644 --- a/tests/th/T7910.hs +++ b/tests/th/T7910.hs @@ -10,6 +10,8 @@ instance C Int type D a = C a +$(return []) + main = print $( do isCInst <- isInstance ''C [ConT ''Int] isDInst <- isInstance ''D [ConT ''Int] diff --git a/tests/th/TH_lookupName.hs b/tests/th/TH_lookupName.hs index 4263d0a..b1c051a 100644 --- a/tests/th/TH_lookupName.hs +++ b/tests/th/TH_lookupName.hs @@ -10,6 +10,8 @@ f = "TH_lookupName.f" data D = D +$(return []) + main = mapM_ print [ -- looking up values $(do { Just n <- lookupValueName "f" ; varE n }), diff --git a/tests/th/TH_reifyDecl1.hs b/tests/th/TH_reifyDecl1.hs index f2f5dd8..4c444f2 100644 --- a/tests/th/TH_reifyDecl1.hs +++ b/tests/th/TH_reifyDecl1.hs @@ -60,6 +60,8 @@ data family DF1 a data family DF2 a data instance DF2 Bool = DBool +$(return []) + test :: () test = $(let display :: Name -> Q () diff --git a/tests/th/TH_reifyInstances.hs b/tests/th/TH_reifyInstances.hs index 9a996d6..431a022 100644 --- a/tests/th/TH_reifyInstances.hs +++ b/tests/th/TH_reifyInstances.hs @@ -28,6 +28,8 @@ data family D2 a data instance D2 Int = DInt | DInt2 data instance D2 Bool = DBool +$(return []) + test :: () test = $(let display :: Name -> Q () diff --git a/tests/th/TH_unresolvedInfix2.hs b/tests/th/TH_unresolvedInfix2.hs index e480c09..eeba6e3 100644 --- a/tests/th/TH_unresolvedInfix2.hs +++ b/tests/th/TH_unresolvedInfix2.hs @@ -8,6 +8,8 @@ data Tree = N | Tree :+ Tree | Tree :* Tree +$(return []) + -- Should fail expr = $( let plus = conE '(:+) n = conE 'N _______________________________________________ ghc-commits mailing list ghc-commits@haskell.org http://www.haskell.org/mailman/listinfo/ghc-commits