Ticket #4429: 0001-Test-4429-5406.patch

File 0001-Test-4429-5406.patch, 9.7 KB (added by reinerp, 3 years ago)
  • new file tests/th/TH_lookupName.hs

    From a349970a6badfee16df00fd4ba5f65634b5e0bd0 Mon Sep 17 00:00:00 2001
    From: Reiner Pope <reiner.pope@gmail.com>
    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
    - +  
     1-- test 'lookupTypeName' and 'lookupValueName' 
     2 
     3import Language.Haskell.TH 
     4 
     5import qualified TH_lookupName_Lib 
     6import qualified TH_lookupName_Lib as TheLib 
     7 
     8f :: String 
     9f = "TH_lookupName.f" 
     10 
     11data D = D 
     12 
     13main = mapM_ print [ 
     14  -- looking up values 
     15  $(do { Just n <- lookupValueName "f" ; varE n }), 
     16  $(do { Nothing <- lookupTypeName "f";  [| "" |] }), 
     17  -- looking up types 
     18  $(do { Just n <- lookupTypeName "String"; sigE [| "" |] (conT n) }), 
     19  $(do { Nothing <- lookupValueName "String"; [| "" |] }), 
     20  -- namespacing 
     21  $(do { Just n <- lookupValueName "D"; DataConI{} <- reify n; [| "" |] }), 
     22  $(do { Just n <- lookupTypeName "D"; TyConI{} <- reify n; [| "" |] }), 
     23  -- qualified lookup 
     24  $(do { Just n <- lookupValueName "TH_lookupName_Lib.f"; varE n }), 
     25  $(do { Just n <- lookupValueName "TheLib.f"; varE n }), 
     26  -- shadowing 
     27  $(TheLib.lookup_f), 
     28  $( [| let f = "local f" in $(TheLib.lookup_f) |] ), 
     29  $( [| let f = "local f" in $(do { Just n <- lookupValueName "f"; varE n }) |] ), 
     30  $( [| let f = "local f" in $(varE 'f) |] ), 
     31  let f = "local f" in $(TheLib.lookup_f), 
     32  let f = "local f" in $(varE 'f) 
     33 ] 
  • new file tests/th/TH_lookupName.stdout

    diff --git a/tests/th/TH_lookupName.stdout b/tests/th/TH_lookupName.stdout
    new file mode 100644
    index 0000000..21a8f43
    - +  
     1"TH_lookupName.f" 
     2"" 
     3"" 
     4"" 
     5"" 
     6"" 
     7"TH_lookupName_Lib.f" 
     8"TH_lookupName_Lib.f" 
     9"TH_lookupName.f" 
     10"TH_lookupName.f" 
     11"TH_lookupName.f" 
     12"local f" 
     13"local f" 
     14"local f" 
  • new file tests/th/TH_lookupName_Lib.hs

    diff --git a/tests/th/TH_lookupName_Lib.hs b/tests/th/TH_lookupName_Lib.hs
    new file mode 100644
    index 0000000..a7b4c4b
    - +  
     1module TH_lookupName_Lib where 
     2 
     3import Language.Haskell.TH 
     4 
     5f :: String 
     6f = "TH_lookupName_Lib.f" 
     7 
     8lookup_f :: Q Exp 
     9lookup_f = do { Just n <- lookupValueName "f"; varE n } 
  • tests/th/TH_reifyDecl1.hs

    diff --git a/tests/th/TH_reifyDecl1.hs b/tests/th/TH_reifyDecl1.hs
    index dfd0518..9c0880b 100644
    a b  
    11-- test reification of data declarations 
    22 
     3{-# LANGUAGE TypeFamilies #-} 
    34module TH_reifyDecl1 where 
    45 
    56import Language.Haskell.TH 
    67import Text.PrettyPrint.HughesPJ 
    78 
    8 infixl 3 `m` 
     9infixl 3 `m1` 
    910 
    1011-- simple 
    1112data T = A | B 
    type IntList = [Int] 
    2627newtype Length = Length Int 
    2728 
    2829-- simple class 
    29 class C a where 
    30   m :: a -> Int 
     30class C1 a where 
     31  m1 :: a -> Int 
     32 
     33-- class with instances 
     34class C2 a where 
     35  m2 :: a -> Int 
     36instance C2 Int where 
     37  m2 x = x 
     38 
     39-- associated types 
     40class C3 a where 
     41  type AT1 a 
     42  data AT2 a 
     43 
     44instance C3 Int where 
     45  type AT1 Int = Bool 
     46  data AT2 Int = AT2Int 
     47 
     48-- type family 
     49type family TF1 a 
     50 
     51-- type family, with instances 
     52type family TF2 a 
     53type instance TF2 Bool = Bool 
     54 
     55-- data family 
     56data family DF1 a 
     57 
     58-- data family, with instances 
     59data family DF2 a 
     60data instance DF2 Bool = DBool 
    3161 
    3262test :: () 
    3363test = $(let  
    test = $(let 
    4070              ; display ''IntList 
    4171              ; display ''Length 
    4272              ; display 'Leaf 
    43               ; display 'm 
     73              ; display 'm1 
     74              ; display ''C1 
     75              ; display ''C2 
     76              ; display ''C3 
     77              ; display ''AT1 
     78              ; display ''AT2 
     79              ; display ''TF1 
     80              ; display ''TF2 
     81              ; display ''DF1 
     82              ; display ''DF2 
    4483              ; [| () |] }) 
    4584 
    4685 
  • tests/th/TH_reifyDecl1.stderr

    diff --git a/tests/th/TH_reifyDecl1.stderr b/tests/th/TH_reifyDecl1.stderr
    index cf4b92d..7f4ae85 100644
    a b  
    11 
    2 TH_reifyDecl1.hs:33:10: 
     2TH_reifyDecl1.hs:63:10: 
    33    data TH_reifyDecl1.T = TH_reifyDecl1.A | TH_reifyDecl1.B 
    44 
    5 TH_reifyDecl1.hs:33:10: 
     5TH_reifyDecl1.hs:63:10: 
    66    data TH_reifyDecl1.R a_0 = TH_reifyDecl1.C a_0 | TH_reifyDecl1.D 
    77 
    8 TH_reifyDecl1.hs:33:10: 
     8TH_reifyDecl1.hs:63:10: 
    99    data TH_reifyDecl1.List a_0 
    1010    = TH_reifyDecl1.Nil 
    1111    | TH_reifyDecl1.Cons a_0 (TH_reifyDecl1.List a_0) 
    1212 
    13 TH_reifyDecl1.hs:33:10: 
     13TH_reifyDecl1.hs:63:10: 
    1414    data TH_reifyDecl1.Tree a_0 
    1515    = TH_reifyDecl1.Leaf 
    1616    | (TH_reifyDecl1.Tree a_0) TH_reifyDecl1.:+: (TH_reifyDecl1.Tree a_0) 
    1717 
    18 TH_reifyDecl1.hs:33:10: 
     18TH_reifyDecl1.hs:63:10: 
    1919    type TH_reifyDecl1.IntList = [GHC.Types.Int] 
    2020 
    21 TH_reifyDecl1.hs:33:10: 
     21TH_reifyDecl1.hs:63:10: 
    2222    newtype TH_reifyDecl1.Length = TH_reifyDecl1.Length GHC.Types.Int 
    2323 
    24 TH_reifyDecl1.hs:33:10: 
     24TH_reifyDecl1.hs:63:10: 
    2525    Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall a_0 . TH_reifyDecl1.Tree a_0 
    2626 
    27 TH_reifyDecl1.hs:33:10: 
    28     Class op from TH_reifyDecl1.C: TH_reifyDecl1.m :: forall a_0 . TH_reifyDecl1.C a_0 => 
    29                                                                a_0 -> GHC.Types.Int 
    30                                infixl 3 TH_reifyDecl1.m 
     27TH_reifyDecl1.hs:63:10: 
     28    Class op from TH_reifyDecl1.C1: TH_reifyDecl1.m1 :: forall a_0 . TH_reifyDecl1.C1 a_0 => 
     29                                                                 a_0 -> GHC.Types.Int 
     30                                infixl 3 TH_reifyDecl1.m1 
     31 
     32TH_reifyDecl1.hs:63:10: 
     33    class TH_reifyDecl1.C1 a_0 
     34    where TH_reifyDecl1.m1 :: forall a_0 . TH_reifyDecl1.C1 a_0 => 
     35                                           a_0 -> GHC.Types.Int 
     36 
     37TH_reifyDecl1.hs:63:10: 
     38    class TH_reifyDecl1.C2 a_0 
     39    where TH_reifyDecl1.m2 :: forall a_0 . TH_reifyDecl1.C2 a_0 => 
     40                                           a_0 -> GHC.Types.Int 
     41instance TH_reifyDecl1.C2 GHC.Types.Int 
     42 
     43TH_reifyDecl1.hs:63:10: 
     44    class TH_reifyDecl1.C3 a_0 
     45instance TH_reifyDecl1.C3 GHC.Types.Int 
     46 
     47TH_reifyDecl1.hs:63:10: 
     48    type family TH_reifyDecl1.AT1 a_0 :: * -> * 
     49type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool 
     50 
     51TH_reifyDecl1.hs:63:10: 
     52    data family TH_reifyDecl1.AT2 a_0 :: * -> * 
     53data instance TH_reifyDecl1.AT2 GHC.Types.Int 
     54    = TH_reifyDecl1.AT2Int 
     55 
     56TH_reifyDecl1.hs:63:10: type family TH_reifyDecl1.TF1 a_0 :: * -> * 
     57 
     58TH_reifyDecl1.hs:63:10: 
     59    type family TH_reifyDecl1.TF2 a_0 :: * -> * 
     60type instance TH_reifyDecl1.TF2 GHC.Types.Bool = GHC.Types.Bool 
     61 
     62TH_reifyDecl1.hs:63:10: data family TH_reifyDecl1.DF1 a_0 :: * -> * 
     63 
     64TH_reifyDecl1.hs:63:10: 
     65    data family TH_reifyDecl1.DF2 a_0 :: * -> * 
     66data instance TH_reifyDecl1.DF2 GHC.Types.Bool 
     67    = TH_reifyDecl1.DBool 
  • new file tests/th/TH_reifyInstances.hs

    diff --git a/tests/th/TH_reifyInstances.hs b/tests/th/TH_reifyInstances.hs
    new file mode 100644
    index 0000000..9a996d6
    - +  
     1-- test reifyInstances 
     2 
     3{-# LANGUAGE TypeFamilies #-} 
     4module TH_reifyInstances where 
     5 
     6import System.IO 
     7import Language.Haskell.TH 
     8import Text.PrettyPrint.HughesPJ 
     9 
     10-- classes 
     11class C1 a where f1 :: a 
     12 
     13class C2 a where f2 :: a 
     14instance C2 Int where f2 = 0 
     15instance C2 Bool where f2 = True 
     16 
     17-- type families 
     18type family T1 a 
     19 
     20type family T2 a 
     21type instance T2 Int = Char 
     22type instance T2 Bool = Int 
     23 
     24-- data families 
     25data family D1 a 
     26 
     27data family D2 a 
     28data instance D2 Int = DInt | DInt2 
     29data instance D2 Bool = DBool 
     30 
     31test :: () 
     32test = $(let 
     33          display :: Name -> Q () 
     34          display n = do  
     35               { intTy <- [t| Int |] 
     36               ; is1 <- reifyInstances n [intTy] 
     37               ; runIO $ hPutStrLn stderr (nameBase n) 
     38               ; runIO $ hPutStrLn stderr (pprint is1) 
     39               } 
     40        in do { display ''C1 
     41              ; display ''C2 
     42              ; display ''T1 
     43              ; display ''T2 
     44              ; display ''D1 
     45              ; display ''D2 
     46              ; [| () |] 
     47              }) 
  • new file tests/th/TH_reifyInstances.stderr

    diff --git a/tests/th/TH_reifyInstances.stderr b/tests/th/TH_reifyInstances.stderr
    new file mode 100644
    index 0000000..21d2ff4
    - +  
     1C1 
     2 
     3C2 
     4instance TH_reifyInstances.C2 GHC.Types.Int 
     5T1 
     6 
     7T2 
     8type instance TH_reifyInstances.T2 GHC.Types.Int = GHC.Types.Char 
     9D1 
     10 
     11D2 
     12data instance TH_reifyInstances.D2 GHC.Types.Int 
     13    = TH_reifyInstances.DInt | TH_reifyInstances.DInt2 
  • tests/th/all.T

    diff --git a/tests/th/all.T b/tests/th/all.T
    index a1c4fbb..3a64f24 100644
    a b test('TH_reifyType1', normal, compile, ['']) 
    7171test('TH_reifyType2', normal, compile, ['']) 
    7272test('TH_reifyMkName', normal, compile, ['-v0']) 
    7373 
     74test('TH_reifyInstances', normal, compile, ['-v0']) 
     75 
    7476test('TH_spliceDecl1', normal, compile, ['-v0']) 
    7577test('TH_spliceDecl2', normal, compile, ['-v0']) 
    7678test('TH_spliceDecl3', 
    test('T5358', normal, compile_fail, ['']) 
    198200test('T5379', normal, compile_and_run, ['']) 
    199201test('T5404', normal, compile, ['-v0']) 
    200202test('T5410', normal, compile_and_run, ['-v0']) 
     203test('TH_lookupName',  
     204     extra_clean(['TH_lookupName_Lib.hi', 'TH_lookupName_Lib.o']), 
     205     multimod_compile_and_run, 
     206     ['TH_lookupName.hs', ''])