From a349970a6badfee16df00fd4ba5f65634b5e0bd0 Mon Sep 17 00:00:00 2001 From: Reiner Pope Date: Wed, 24 Aug 2011 09:41:09 +1000 Subject: [PATCH] Test #4429, #5406 --- tests/th/TH_lookupName.hs | 33 ++++++++++++++++++++ tests/th/TH_lookupName.stdout | 14 +++++++++ tests/th/TH_lookupName_Lib.hs | 9 +++++ tests/th/TH_reifyDecl1.hs | 47 +++++++++++++++++++++++++++-- tests/th/TH_reifyDecl1.stderr | 59 ++++++++++++++++++++++++++++++------- tests/th/TH_reifyInstances.hs | 47 +++++++++++++++++++++++++++++ tests/th/TH_reifyInstances.stderr | 13 ++++++++ tests/th/all.T | 6 ++++ 8 files changed, 213 insertions(+), 15 deletions(-) create mode 100644 tests/th/TH_lookupName.hs create mode 100644 tests/th/TH_lookupName.stdout create mode 100644 tests/th/TH_lookupName_Lib.hs create mode 100644 tests/th/TH_reifyInstances.hs create mode 100644 tests/th/TH_reifyInstances.stderr diff --git a/tests/th/TH_lookupName.hs b/tests/th/TH_lookupName.hs new file mode 100644 index 0000000..4263d0a --- /dev/null +++ b/tests/th/TH_lookupName.hs @@ -0,0 +1,33 @@ +-- test 'lookupTypeName' and 'lookupValueName' + +import Language.Haskell.TH + +import qualified TH_lookupName_Lib +import qualified TH_lookupName_Lib as TheLib + +f :: String +f = "TH_lookupName.f" + +data D = D + +main = mapM_ print [ + -- looking up values + $(do { Just n <- lookupValueName "f" ; varE n }), + $(do { Nothing <- lookupTypeName "f"; [| "" |] }), + -- looking up types + $(do { Just n <- lookupTypeName "String"; sigE [| "" |] (conT n) }), + $(do { Nothing <- lookupValueName "String"; [| "" |] }), + -- namespacing + $(do { Just n <- lookupValueName "D"; DataConI{} <- reify n; [| "" |] }), + $(do { Just n <- lookupTypeName "D"; TyConI{} <- reify n; [| "" |] }), + -- qualified lookup + $(do { Just n <- lookupValueName "TH_lookupName_Lib.f"; varE n }), + $(do { Just n <- lookupValueName "TheLib.f"; varE n }), + -- shadowing + $(TheLib.lookup_f), + $( [| let f = "local f" in $(TheLib.lookup_f) |] ), + $( [| let f = "local f" in $(do { Just n <- lookupValueName "f"; varE n }) |] ), + $( [| let f = "local f" in $(varE 'f) |] ), + let f = "local f" in $(TheLib.lookup_f), + let f = "local f" in $(varE 'f) + ] diff --git a/tests/th/TH_lookupName.stdout b/tests/th/TH_lookupName.stdout new file mode 100644 index 0000000..21a8f43 --- /dev/null +++ b/tests/th/TH_lookupName.stdout @@ -0,0 +1,14 @@ +"TH_lookupName.f" +"" +"" +"" +"" +"" +"TH_lookupName_Lib.f" +"TH_lookupName_Lib.f" +"TH_lookupName.f" +"TH_lookupName.f" +"TH_lookupName.f" +"local f" +"local f" +"local f" diff --git a/tests/th/TH_lookupName_Lib.hs b/tests/th/TH_lookupName_Lib.hs new file mode 100644 index 0000000..a7b4c4b --- /dev/null +++ b/tests/th/TH_lookupName_Lib.hs @@ -0,0 +1,9 @@ +module TH_lookupName_Lib where + +import Language.Haskell.TH + +f :: String +f = "TH_lookupName_Lib.f" + +lookup_f :: Q Exp +lookup_f = do { Just n <- lookupValueName "f"; varE n } diff --git a/tests/th/TH_reifyDecl1.hs b/tests/th/TH_reifyDecl1.hs index dfd0518..9c0880b 100644 --- a/tests/th/TH_reifyDecl1.hs +++ b/tests/th/TH_reifyDecl1.hs @@ -1,11 +1,12 @@ -- test reification of data declarations +{-# LANGUAGE TypeFamilies #-} module TH_reifyDecl1 where import Language.Haskell.TH import Text.PrettyPrint.HughesPJ -infixl 3 `m` +infixl 3 `m1` -- simple data T = A | B @@ -26,8 +27,37 @@ type IntList = [Int] newtype Length = Length Int -- simple class -class C a where - m :: a -> Int +class C1 a where + m1 :: a -> Int + +-- class with instances +class C2 a where + m2 :: a -> Int +instance C2 Int where + m2 x = x + +-- associated types +class C3 a where + type AT1 a + data AT2 a + +instance C3 Int where + type AT1 Int = Bool + data AT2 Int = AT2Int + +-- type family +type family TF1 a + +-- type family, with instances +type family TF2 a +type instance TF2 Bool = Bool + +-- data family +data family DF1 a + +-- data family, with instances +data family DF2 a +data instance DF2 Bool = DBool test :: () test = $(let @@ -40,7 +70,16 @@ test = $(let ; display ''IntList ; display ''Length ; display 'Leaf - ; display 'm + ; display 'm1 + ; display ''C1 + ; display ''C2 + ; display ''C3 + ; display ''AT1 + ; display ''AT2 + ; display ''TF1 + ; display ''TF2 + ; display ''DF1 + ; display ''DF2 ; [| () |] }) diff --git a/tests/th/TH_reifyDecl1.stderr b/tests/th/TH_reifyDecl1.stderr index cf4b92d..7f4ae85 100644 --- a/tests/th/TH_reifyDecl1.stderr +++ b/tests/th/TH_reifyDecl1.stderr @@ -1,30 +1,67 @@ -TH_reifyDecl1.hs:33:10: +TH_reifyDecl1.hs:63:10: data TH_reifyDecl1.T = TH_reifyDecl1.A | TH_reifyDecl1.B -TH_reifyDecl1.hs:33:10: +TH_reifyDecl1.hs:63:10: data TH_reifyDecl1.R a_0 = TH_reifyDecl1.C a_0 | TH_reifyDecl1.D -TH_reifyDecl1.hs:33:10: +TH_reifyDecl1.hs:63:10: data TH_reifyDecl1.List a_0 = TH_reifyDecl1.Nil | TH_reifyDecl1.Cons a_0 (TH_reifyDecl1.List a_0) -TH_reifyDecl1.hs:33:10: +TH_reifyDecl1.hs:63:10: data TH_reifyDecl1.Tree a_0 = TH_reifyDecl1.Leaf | (TH_reifyDecl1.Tree a_0) TH_reifyDecl1.:+: (TH_reifyDecl1.Tree a_0) -TH_reifyDecl1.hs:33:10: +TH_reifyDecl1.hs:63:10: type TH_reifyDecl1.IntList = [GHC.Types.Int] -TH_reifyDecl1.hs:33:10: +TH_reifyDecl1.hs:63:10: newtype TH_reifyDecl1.Length = TH_reifyDecl1.Length GHC.Types.Int -TH_reifyDecl1.hs:33:10: +TH_reifyDecl1.hs:63:10: Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall a_0 . TH_reifyDecl1.Tree a_0 -TH_reifyDecl1.hs:33:10: - Class op from TH_reifyDecl1.C: TH_reifyDecl1.m :: forall a_0 . TH_reifyDecl1.C a_0 => - a_0 -> GHC.Types.Int - infixl 3 TH_reifyDecl1.m +TH_reifyDecl1.hs:63:10: + Class op from TH_reifyDecl1.C1: TH_reifyDecl1.m1 :: forall a_0 . TH_reifyDecl1.C1 a_0 => + a_0 -> GHC.Types.Int + infixl 3 TH_reifyDecl1.m1 + +TH_reifyDecl1.hs:63:10: + class TH_reifyDecl1.C1 a_0 + where TH_reifyDecl1.m1 :: forall a_0 . TH_reifyDecl1.C1 a_0 => + a_0 -> GHC.Types.Int + +TH_reifyDecl1.hs:63:10: + class TH_reifyDecl1.C2 a_0 + where TH_reifyDecl1.m2 :: forall a_0 . TH_reifyDecl1.C2 a_0 => + a_0 -> GHC.Types.Int +instance TH_reifyDecl1.C2 GHC.Types.Int + +TH_reifyDecl1.hs:63:10: + class TH_reifyDecl1.C3 a_0 +instance TH_reifyDecl1.C3 GHC.Types.Int + +TH_reifyDecl1.hs:63:10: + type family TH_reifyDecl1.AT1 a_0 :: * -> * +type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool + +TH_reifyDecl1.hs:63:10: + data family TH_reifyDecl1.AT2 a_0 :: * -> * +data instance TH_reifyDecl1.AT2 GHC.Types.Int + = TH_reifyDecl1.AT2Int + +TH_reifyDecl1.hs:63:10: type family TH_reifyDecl1.TF1 a_0 :: * -> * + +TH_reifyDecl1.hs:63:10: + type family TH_reifyDecl1.TF2 a_0 :: * -> * +type instance TH_reifyDecl1.TF2 GHC.Types.Bool = GHC.Types.Bool + +TH_reifyDecl1.hs:63:10: data family TH_reifyDecl1.DF1 a_0 :: * -> * + +TH_reifyDecl1.hs:63:10: + data family TH_reifyDecl1.DF2 a_0 :: * -> * +data instance TH_reifyDecl1.DF2 GHC.Types.Bool + = TH_reifyDecl1.DBool diff --git a/tests/th/TH_reifyInstances.hs b/tests/th/TH_reifyInstances.hs new file mode 100644 index 0000000..9a996d6 --- /dev/null +++ b/tests/th/TH_reifyInstances.hs @@ -0,0 +1,47 @@ +-- test reifyInstances + +{-# LANGUAGE TypeFamilies #-} +module TH_reifyInstances where + +import System.IO +import Language.Haskell.TH +import Text.PrettyPrint.HughesPJ + +-- classes +class C1 a where f1 :: a + +class C2 a where f2 :: a +instance C2 Int where f2 = 0 +instance C2 Bool where f2 = True + +-- type families +type family T1 a + +type family T2 a +type instance T2 Int = Char +type instance T2 Bool = Int + +-- data families +data family D1 a + +data family D2 a +data instance D2 Int = DInt | DInt2 +data instance D2 Bool = DBool + +test :: () +test = $(let + display :: Name -> Q () + display n = do + { intTy <- [t| Int |] + ; is1 <- reifyInstances n [intTy] + ; runIO $ hPutStrLn stderr (nameBase n) + ; runIO $ hPutStrLn stderr (pprint is1) + } + in do { display ''C1 + ; display ''C2 + ; display ''T1 + ; display ''T2 + ; display ''D1 + ; display ''D2 + ; [| () |] + }) diff --git a/tests/th/TH_reifyInstances.stderr b/tests/th/TH_reifyInstances.stderr new file mode 100644 index 0000000..21d2ff4 --- /dev/null +++ b/tests/th/TH_reifyInstances.stderr @@ -0,0 +1,13 @@ +C1 + +C2 +instance TH_reifyInstances.C2 GHC.Types.Int +T1 + +T2 +type instance TH_reifyInstances.T2 GHC.Types.Int = GHC.Types.Char +D1 + +D2 +data instance TH_reifyInstances.D2 GHC.Types.Int + = TH_reifyInstances.DInt | TH_reifyInstances.DInt2 diff --git a/tests/th/all.T b/tests/th/all.T index a1c4fbb..3a64f24 100644 --- a/tests/th/all.T +++ b/tests/th/all.T @@ -71,6 +71,8 @@ test('TH_reifyType1', normal, compile, ['']) test('TH_reifyType2', normal, compile, ['']) test('TH_reifyMkName', normal, compile, ['-v0']) +test('TH_reifyInstances', normal, compile, ['-v0']) + test('TH_spliceDecl1', normal, compile, ['-v0']) test('TH_spliceDecl2', normal, compile, ['-v0']) test('TH_spliceDecl3', @@ -198,3 +200,7 @@ test('T5358', normal, compile_fail, ['']) test('T5379', normal, compile_and_run, ['']) test('T5404', normal, compile, ['-v0']) test('T5410', normal, compile_and_run, ['-v0']) +test('TH_lookupName', + extra_clean(['TH_lookupName_Lib.hi', 'TH_lookupName_Lib.o']), + multimod_compile_and_run, + ['TH_lookupName.hs', '']) -- 1.7.6