Ticket #4430: testsuite-0001-Test-unresolved-infix-expressions-and-patterns.patch

File testsuite-0001-Test-unresolved-infix-expressions-and-patterns.patch, 9.9 KB (added by reinerp, 3 years ago)
  • new file tests/th/TH_unresolvedInfix.hs

    From 360ffa4d61f57b0503c695a9da6423fd5addf55b Mon Sep 17 00:00:00 2001
    From: Reiner Pope <reiner.pope@gmail.com>
    Date: Sat, 23 Jul 2011 16:21:58 +1000
    Subject: [PATCH 1/2] Test unresolved infix expressions and patterns
    
    ---
     tests/th/TH_unresolvedInfix.hs      |  109 +++++++++++++++++++++++++++++++++++
     tests/th/TH_unresolvedInfix.stdout  |   46 +++++++++++++++
     tests/th/TH_unresolvedInfix2.hs     |    6 ++
     tests/th/TH_unresolvedInfix2.stderr |   12 ++++
     tests/th/TH_unresolvedInfix_Lib.hs  |   74 +++++++++++++++++++++++
     tests/th/all.T                      |    8 +++
     6 files changed, 255 insertions(+), 0 deletions(-)
     create mode 100644 tests/th/TH_unresolvedInfix.hs
     create mode 100644 tests/th/TH_unresolvedInfix.stdout
     create mode 100644 tests/th/TH_unresolvedInfix2.hs
     create mode 100644 tests/th/TH_unresolvedInfix2.stderr
     create mode 100644 tests/th/TH_unresolvedInfix_Lib.hs
    
    diff --git a/tests/th/TH_unresolvedInfix.hs b/tests/th/TH_unresolvedInfix.hs
    new file mode 100644
    index 0000000..03e97cf
    - +  
     1{-# LANGUAGE QuasiQuotes #-} 
     2 
     3module Main where 
     4 
     5import TH_unresolvedInfix_Lib 
     6import Language.Haskell.TH 
     7 
     8-------------------------------------------------------------------------------- 
     9--                                Expressions                                 -- 
     10-------------------------------------------------------------------------------- 
     11exprs = [ 
     12-------------- Completely-unresolved bindings 
     13  $( n +? (n *? n) ), 
     14  $( (n +? n) *? n ), 
     15  $( n +? (n +? n) ), 
     16  $( (n +? n) +? n ), 
     17  -- VarE version 
     18  $( uInfixE n plus2 (uInfixE n plus2 n) ), 
     19  $( uInfixE (uInfixE n plus2 n) plus2 n ), 
     20  $( uInfixE n plus3 (uInfixE n plus3 n) ), 
     21  $( uInfixE (uInfixE n plus3 n) plus3 n ), 
     22 
     23--------------- Completely-resolved bindings 
     24  $( n +! (n *! n) ), 
     25  $( (n +! n) *! n ), 
     26  $( n +! (n +! n) ), 
     27  $( (n +! n) +! n ), 
     28 
     29-------------- Mixed resolved/unresolved 
     30  $( (n +! n) *? (n +? n) ), 
     31  $( (n +? n) *? (n +! n) ), 
     32  $( (n +? n) *! (n +! n) ), 
     33  $( (n +? n) *! (n +? n) ), 
     34 
     35-------------- Parens 
     36  $( ((parensE ((n +? n) *? n)) +? n) *? n ), 
     37  $( (parensE (n +? n)) *? (parensE (n +? n)) ), 
     38  $( parensE ((n +? n) *? (n +? n)) ), 
     39 
     40-------------- Sections 
     41  $( infixE (Just $ n +? n) plus Nothing ) N, 
     42  -- see B.hs for the (non-compiling) other version of the above 
     43  $( infixE Nothing plus (Just $ parensE $ uInfixE n plus n) ) N, 
     44 
     45-------------- Dropping constructors 
     46  $( n *? tupE [n +? n] ) 
     47  ] 
     48 
     49-------------------------------------------------------------------------------- 
     50--                                  Patterns                                  -- 
     51-------------------------------------------------------------------------------- 
     52patterns = [ 
     53-------------- Completely-unresolved patterns 
     54  case N :+ (N :* N) of 
     55    [p1|unused|] -> True, 
     56  case N :+ (N :* N) of 
     57    [p2|unused|] -> True, 
     58  case (N :+ N) :+ N of 
     59    [p3|unused|] -> True, 
     60  case (N :+ N) :+ N of 
     61    [p4|unused|] -> True, 
     62-------------- Completely-resolved patterns 
     63  case N :+ (N :* N) of 
     64    [p5|unused|] -> True, 
     65  case (N :+ N) :* N of 
     66    [p6|unused|] -> True, 
     67  case N :+ (N :+ N) of 
     68    [p7|unused|] -> True, 
     69  case (N :+ N) :+ N of 
     70    [p8|unused|] -> True, 
     71-------------- Mixed resolved/unresolved 
     72  case ((N :+ N) :* N) :+ N of 
     73    [p9|unused|] -> True, 
     74  case N :+ (N :* (N :+ N)) of 
     75    [p10|unused|] -> True, 
     76  case (N :+ N) :* (N :+ N) of 
     77    [p11|unused|] -> True, 
     78  case (N :+ N) :* (N :+ N) of 
     79    [p12|unused|] -> True, 
     80-------------- Parens 
     81  case (N :+ (N :* N)) :+ (N :* N) of 
     82    [p13|unused|] -> True, 
     83  case (N :+ N) :* (N :+ N) of 
     84    [p14|unused|] -> True, 
     85  case (N :+ (N :* N)) :+ N of 
     86    [p15|unused|] -> True, 
     87-------------- Dropping constructors 
     88  case (N :* (N :+ N)) of 
     89    [p16|unused|] -> True 
     90 ] 
     91 
     92main = do 
     93  mapM_ print exprs 
     94  mapM_ print patterns 
     95  -- check that there are no Parens or UInfixes in the output 
     96  runQ [|N :* N :+ N|] >>= print 
     97  runQ [|(N :* N) :+ N|] >>= print 
     98  runQ [p|N :* N :+ N|] >>= print 
     99  runQ [p|(N :* N) :+ N|] >>= print 
     100 
     101  -- pretty-printing of unresolved infix expressions 
     102  let ne = ConE $ mkName "N" 
     103      np = ConP (mkName "N") [] 
     104      plusE = ConE (mkName ":+") 
     105      plusP = (mkName ":+") 
     106  putStrLn $ pprint (InfixE (Just ne) plusE (Just $ UInfixE ne plusE (UInfixE ne plusE ne))) 
     107  putStrLn $ pprint (ParensE ne) 
     108  putStrLn $ pprint (InfixP np plusP (UInfixP np plusP (UInfixP np plusP np))) 
     109  putStrLn $ pprint (ParensP np) 
  • new file tests/th/TH_unresolvedInfix.stdout

    diff --git a/tests/th/TH_unresolvedInfix.stdout b/tests/th/TH_unresolvedInfix.stdout
    new file mode 100644
    index 0000000..9ef0da4
    - +  
     1(N :+ (N :* N)) 
     2(N :+ (N :* N)) 
     3((N :+ N) :+ N) 
     4((N :+ N) :+ N) 
     5((N :+ N) :+ N) 
     6((N :+ N) :+ N) 
     7((N :+ N) :+ N) 
     8((N :+ N) :+ N) 
     9(N :+ (N :* N)) 
     10((N :+ N) :* N) 
     11(N :+ (N :+ N)) 
     12((N :+ N) :+ N) 
     13(((N :+ N) :* N) :+ N) 
     14(N :+ (N :* (N :+ N))) 
     15((N :+ N) :* (N :+ N)) 
     16((N :+ N) :* (N :+ N)) 
     17((N :+ (N :* N)) :+ (N :* N)) 
     18((N :+ N) :* (N :+ N)) 
     19((N :+ (N :* N)) :+ N) 
     20((N :+ N) :+ N) 
     21(N :+ (N :+ N)) 
     22(N :* (N :+ N)) 
     23True 
     24True 
     25True 
     26True 
     27True 
     28True 
     29True 
     30True 
     31True 
     32True 
     33True 
     34True 
     35True 
     36True 
     37True 
     38True 
     39InfixE (Just (InfixE (Just (ConE TH_unresolvedInfix_Lib.N)) (ConE TH_unresolvedInfix_Lib.:*) (Just (ConE TH_unresolvedInfix_Lib.N)))) (ConE TH_unresolvedInfix_Lib.:+) (Just (ConE TH_unresolvedInfix_Lib.N)) 
     40InfixE (Just (InfixE (Just (ConE TH_unresolvedInfix_Lib.N)) (ConE TH_unresolvedInfix_Lib.:*) (Just (ConE TH_unresolvedInfix_Lib.N)))) (ConE TH_unresolvedInfix_Lib.:+) (Just (ConE TH_unresolvedInfix_Lib.N)) 
     41InfixP (InfixP (ConP TH_unresolvedInfix_Lib.N []) TH_unresolvedInfix_Lib.:* (ConP TH_unresolvedInfix_Lib.N [])) TH_unresolvedInfix_Lib.:+ (ConP TH_unresolvedInfix_Lib.N []) 
     42InfixP (InfixP (ConP TH_unresolvedInfix_Lib.N []) TH_unresolvedInfix_Lib.:* (ConP TH_unresolvedInfix_Lib.N [])) TH_unresolvedInfix_Lib.:+ (ConP TH_unresolvedInfix_Lib.N []) 
     43N :+ (N :+ N :+ N) 
     44(N) 
     45N :+ (N :+ N :+ N) 
     46(N) 
  • new file tests/th/TH_unresolvedInfix2.hs

    diff --git a/tests/th/TH_unresolvedInfix2.hs b/tests/th/TH_unresolvedInfix2.hs
    new file mode 100644
    index 0000000..5cd8332
    - +  
     1module TH_unresolvedInfix2 where 
     2 
     3import TH_unresolvedInfix_Lib 
     4import Language.Haskell.TH 
     5 
     6expr = $( infixE Nothing plus (Just $ n +? n) ) 
  • new file tests/th/TH_unresolvedInfix2.stderr

    diff --git a/tests/th/TH_unresolvedInfix2.stderr b/tests/th/TH_unresolvedInfix2.stderr
    new file mode 100644
    index 0000000..44c4324
    - +  
     1 
     2TH_unresolvedInfix2.hs:6:11: 
     3   The operator `:+' [infixl 6] of a section 
     4       must have lower precedence than that of the operand, 
     5         namely `:+' [infixl 6] 
     6       in the section: `:+ N :+ N' 
     7   In the result of the splice: 
     8     $(infixE Nothing plus (Just $ n +? n)) 
     9   To see what the splice expanded to, use -ddump-splices 
     10   In the expression: $(infixE Nothing plus (Just $ n +? n)) 
     11   In an equation for `expr': 
     12       expr = $(infixE Nothing plus (Just $ n +? n)) 
  • new file tests/th/TH_unresolvedInfix_Lib.hs

    diff --git a/tests/th/TH_unresolvedInfix_Lib.hs b/tests/th/TH_unresolvedInfix_Lib.hs
    new file mode 100644
    index 0000000..aa734ab
    - +  
     1module TH_unresolvedInfix_Lib where 
     2 
     3import Language.Haskell.TH 
     4import Language.Haskell.TH.Lib 
     5import Language.Haskell.TH.Quote 
     6 
     7infixl 6 :+ 
     8infixl 7 :* 
     9 
     10data Tree = N 
     11  | Tree :+ Tree  
     12  | Tree :* Tree  
     13 
     14-- custom instance, including redundant parentheses 
     15instance Show Tree where 
     16  show N = "N" 
     17  show (a :+ b) = "(" ++ show a ++ " :+ " ++ show b ++ ")" 
     18  show (a :* b) = "(" ++ show a ++ " :* " ++ show b ++ ")" 
     19 
     20-- VarE versions 
     21infixl 6 +: 
     22infixl 7 *: 
     23(+:) = (:+) 
     24(*:) = (:*) 
     25 
     26n = conE (mkName "N") 
     27plus = conE (mkName ":+") 
     28times = conE (mkName ":*") 
     29 
     30a +? b = uInfixE a plus b 
     31a *? b = uInfixE a times b 
     32a +! b = infixApp a plus b 
     33a *! b = infixApp a times b 
     34 
     35plus2 = varE (mkName "+:") 
     36times2 = varE (mkName "*:") 
     37plus3 = conE ('(:+)) 
     38 
     39 
     40-------------------------------------------------------------------------------- 
     41--                                  Patterns                                  -- 
     42-------------------------------------------------------------------------------- 
     43-- The only way to test pattern splices is using QuasiQuotation 
     44mkQQ pat = QuasiQuoter undefined (const pat) undefined undefined 
     45p = conP (mkName "N") [] 
     46plus' = mkName ":+" 
     47times' = mkName ":*" 
     48 
     49a ^+? b = uInfixP a plus' b 
     50a ^*? b = uInfixP a times' b 
     51a ^+! b = infixP a plus' b 
     52a ^*! b = infixP a times' b 
     53 
     54-------------- Completely-unresolved patterns 
     55p1 = mkQQ ( p ^+? (p ^*? p) ) 
     56p2 = mkQQ ( (p ^+? p) ^*? p ) 
     57p3 = mkQQ ( p ^+? (p ^+? p) ) 
     58p4 = mkQQ ( (p ^+? p) ^+? p ) 
     59-------------- Completely-resolved patterns 
     60p5 = mkQQ ( p ^+! (p ^*! p) ) 
     61p6 = mkQQ ( (p ^+! p) ^*! p ) 
     62p7 = mkQQ ( p ^+! (p ^+! p) ) 
     63p8 = mkQQ ( (p ^+! p) ^+! p ) 
     64-------------- Mixed resolved/unresolved 
     65p9 = mkQQ ( (p ^+! p) ^*? (p ^+? p) ) 
     66p10 = mkQQ ( (p ^+? p) ^*? (p ^+! p) ) 
     67p11 = mkQQ ( (p ^+? p) ^*! (p ^+! p) ) 
     68p12 = mkQQ ( (p ^+? p) ^*! (p ^+? p) ) 
     69-------------- Parens 
     70p13 = mkQQ ( ((parensP ((p ^+? p) ^*? p)) ^+? p) ^*? p ) 
     71p14 = mkQQ ( (parensP (p ^+? p)) ^*? (parensP (p ^+? p)) ) 
     72p15 = mkQQ ( parensP ((p ^+? p) ^*? (p ^+? p)) ) 
     73-------------- Dropping constructors 
     74p16 = mkQQ ( p ^*? (tupP [p ^+? p]) ) 
  • tests/th/all.T

    diff --git a/tests/th/all.T b/tests/th/all.T
    index f490f39..347466b 100644
    a b test('T5037', normal, compile, ['-v0']) 
    184184test('TH_unboxedSingleton', normal, compile, ['-v0']) 
    185185test('T5290', normal, compile, ['-v0 -ddump-splices']) 
    186186 
     187test('TH_unresolvedInfix', 
     188     extra_clean(['TH_unresolvedInfix_Lib.hi', 'TH_unresolvedInfix_Lib.o']), 
     189     multimod_compile_and_run, 
     190     ['TH_unresolvedInfix.hs', '-v0']) 
     191test('TH_unresolvedInfix2', 
     192     extra_clean(['TH_unresolvedInfix_Lib.hi', 'TH_unresolvedInfix_Lib.o']), 
     193     multimod_compile_fail, 
     194     ['TH_unresolvedInfix2.hs', '-v0'])