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

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

    From a349970a6badfee16df00fd4ba5f65634b5e0bd0 Mon Sep 17 00:00:00 2001
    From: Reiner Pope <[email protected]>
    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', ''])