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, 4 years ago)
  • new file tests/th/TH_unresolvedInfix.hs

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