test-match-typed.rkt (8903B)
1 #lang typed/racket 2 3 (require xlist 4 typed/rackunit) 5 6 (define-syntax-rule (check-match v clause result) 7 (check-equal? (let ([no-match (gensym 'no-match)]) 8 (match v clause [_ no-match])) 9 result)) 10 11 (define-syntax-rule (check-not-match v pat) 12 (let ([no-match (gensym 'no-match)]) 13 (check-equal? (match v pat [_ no-match]) 14 no-match))) 15 16 (define-syntax-rule (check-match? v pat) 17 (check-true (match v [pat #t] [_ #f]))) 18 19 (define-syntax-rule (check-not-match? v pat) 20 (check-false (match v [pat #t] [_ #f]))) 21 22 (test-begin 23 "(xlist 1 2 3 4 5)" 24 (check-match? '() (xlist)) 25 (check-match? '(1) (xlist 1)) 26 (check-match? '(1 2) (xlist 1 2)) 27 (check-match? '(1 2 3) (xlist 1 2 3)) 28 (check-match? '(1 2 3 4) (xlist 1 2 3 4)) 29 (check-match? '(1 2 3 4 5) (xlist 1 2 3 4 5)) 30 31 (check-not-match? '() (xlist 1)) 32 (check-not-match? '(1) (xlist 1 2)) 33 (check-not-match? '(1 2) (xlist 1 2 3)) 34 (check-not-match? '(1 2 3) (xlist 1 2 3 4)) 35 (check-not-match? '(1 2 3 4) (xlist 1 2 3 4 5)) 36 (check-not-match? '(1 2 3 4 5) (xlist 1 2 3 4 5 6)) 37 38 (check-not-match? '(1) (xlist)) 39 (check-not-match? '(1 2) (xlist 1)) 40 (check-not-match? '(1 2 3) (xlist 1 2)) 41 (check-not-match? '(1 2 3 4) (xlist 1 2 3)) 42 (check-not-match? '(1 2 3 4 5) (xlist 1 2 3 4)) 43 (check-not-match? '(1 2 3 4 5 6) (xlist 1 2 3 4 5)) 44 (void)) 45 46 ;; Should fail: 47 ;(xlist ^ 1) 48 ;(xlist ^ 1 +) 49 ;(xlist ^ 1 *) 50 ;(xlist +) 51 ;(xlist *) 52 53 (test-begin 54 "(xlist 1 *) and (xlist 1 +) with or witout ^" 55 (check-match? '() (xlist 1 *)) 56 (check-match? '(1) (xlist 1 *)) 57 (check-match? '(1 1) (xlist 1 *)) 58 (check-match? '(1 1 1) (xlist 1 *)) 59 60 (check-not-match? '() (xlist 1 +)) 61 (check-match? '(1) (xlist 1 +)) 62 (check-match? '(1 1) (xlist 1 +)) 63 (check-match? '(1 1 1) (xlist 1 +)) 64 65 (check-match? '() (xlist 1 ^ *)) 66 (check-match? '(1) (xlist 1 ^ *)) 67 (check-match? '(1 1) (xlist 1 ^ *)) 68 (check-match? '(1 1 1) (xlist 1 ^ *)) 69 70 (check-not-match? '() (xlist 1 ^ +)) 71 (check-match? '(1) (xlist 1 ^ +)) 72 (check-match? '(1 1) (xlist 1 ^ +)) 73 (check-match? '(1 1 1) (xlist 1 ^ +)) 74 (void)) 75 76 77 (test-begin 78 "(xlist (? number? n) *) and (xlist (? number? n) +) with or witout ^" 79 (check-match '() [(xlist (? number? n) *) n] '()) 80 (check-match '(1) [(xlist (? number? n) *) n] '(1)) 81 (check-match '(1 1) [(xlist (? number? n) *) n] '(1 1)) 82 (check-match '(1 1 1) [(xlist (? number? n) *) n] '(1 1 1)) 83 84 (check-not-match '() [(xlist (? number? n) +) n]) 85 (check-match '(1) [(xlist (? number? n) +) n] '(1)) 86 (check-match '(1 1) [(xlist (? number? n) +) n] '(1 1)) 87 (check-match '(1 1 1) [(xlist (? number? n) +) n] '(1 1 1)) 88 89 (check-match '() [(xlist (? number? n) ^ *) n] '()) 90 (check-match '(1) [(xlist (? number? n) ^ *) n] '(1)) 91 (check-match '(1 1) [(xlist (? number? n) ^ *) n] '(1 1)) 92 (check-match '(1 1 1) [(xlist (? number? n) ^ *) n] '(1 1 1 )) 93 94 (check-not-match '() [(xlist (? number? n) ^ +) n]) 95 (check-match '(1) [(xlist (? number? n) ^ +) n] '(1)) 96 (check-match '(1 1) [(xlist (? number? n) ^ +) n] '(1 1)) 97 (check-match '(1 1 1) [(xlist (? number? n) ^ +) n] '(1 1 1)) 98 (void)) 99 100 (test-begin 101 "(xlist (? number? n) *) and (xlist (? number? n) +) something after" 102 (check-match '() [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ())) 103 (check-match '(1) [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1) . ())) 104 (check-match '("b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ("b"))) 105 (check-match '(1 "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1) . ("b"))) 106 (check-match '(1 1 1 "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1 1 1) . ("b" "b"))) 107 (check-match '(1 1 1) [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1 1 1) . ())) 108 (check-match '("b" "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ("b" "b" "b"))) 109 110 (check-not-match '() [(xlist (? number? n) + (? string? s) +) (cons n s)]) 111 (check-not-match '(1) [(xlist (? number? n) + (? string? s) +) (cons n s)]) 112 (check-not-match '("b") [(xlist (? number? n) + (? string? s) +) (cons n s)]) 113 (check-match '(1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1) . ("b"))) 114 (check-match '(1 1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1 1) . ("b"))) 115 (check-match '(1 "b" "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1) . ("b" "b"))) 116 117 (check-match '() [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ())) 118 (check-match '(1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1) . ())) 119 (check-match '("b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ("b"))) 120 (check-match '(1 "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1) . ("b"))) 121 (check-match '(1 1 1 "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1 1 1) . ("b" "b"))) 122 (check-match '(1 1 1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1 1 1) . ())) 123 (check-match '("b" "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ("b" "b" "b"))) 124 125 (check-not-match '() [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)]) 126 (check-not-match '(1) [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)]) 127 (check-not-match '("b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)]) 128 (check-match '(1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1) . ("b"))) 129 (check-match '(1 1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1 1) . ("b"))) 130 (check-match '(1 "b" "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1) . ("b" "b"))) 131 (void)) 132 133 (test-begin 134 "(xlist (? number? n) ^ x +)" 135 (check-match '(1 1 1) [(xlist (? number? n) +) n] '(1 1 1)) 136 (check-match '(1 1 1) [(xlist (? number? n) ^ +) n] '(1 1 1)) 137 (check-match '(1 1 1) [(xlist (? number? n) ^ 0 +) n] '(1 1 1)) 138 (check-match '(1 1 1) [(xlist (? number? n) ^ 1 +) n] '(1 1 1)) 139 (check-match '(1 1 1) [(xlist (? number? n) ^ 2 +) n] '(1 1 1)) 140 (check-match '(1 1 1) [(xlist (? number? n) ^ 3 +) n] '(1 1 1)) 141 (void)) 142 143 (test-begin 144 "(xlist (? number? n) ^ x - y)" 145 (check-match '() [(xlist (? number? n) ^ -) n] '()) 146 (check-match '(1 1 1) [(xlist (? number? n) ^ -) n] '(1 1 1)) 147 (check-match '() [(xlist (? number? n) ^ 0 -) n] '()) 148 (check-match '(1 1 1) [(xlist (? number? n) ^ 0 -) n] '(1 1 1)) 149 (check-match '(1 1 1) [(xlist (? number? n) ^ 1 -) n] '(1 1 1)) 150 (check-match '(1 1 1) [(xlist (? number? n) ^ 2 -) n] '(1 1 1)) 151 (check-match '(1 1 1) [(xlist (? number? n) ^ 3 -) n] '(1 1 1)) 152 (check-match '() [(xlist (? number? n) ^ - ∞) n] '()) 153 (check-match '(1 1 1) [(xlist (? number? n) ^ - ∞) n] '(1 1 1)) 154 (check-match '() [(xlist (? number? n) ^ 0 - ∞) n] '()) 155 (check-match '(1 1 1) [(xlist (? number? n) ^ 0 - ∞) n] '(1 1 1)) 156 (check-match '(1 1 1) [(xlist (? number? n) ^ 1 - ∞) n] '(1 1 1)) 157 (check-match '(1 1 1) [(xlist (? number? n) ^ 2 - ∞) n] '(1 1 1)) 158 (check-match '(1 1 1) [(xlist (? number? n) ^ 3 - ∞) n] '(1 1 1)) 159 (check-match '(1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1)) 160 (check-match '(1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1)) 161 (check-match '(1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1 1)) 162 (check-match '(1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1 1)) 163 (check-match '(1 1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1 1 1)) 164 (check-match '(1 1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1 1 1)) 165 (void)) 166 167 (test-begin 168 "(xlist (? number? n) ^ x - (? string? s))" 169 (check-match '("b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] '(() . "b")) 170 (check-match '(1 1 1 "b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] '((1 1 1) . "b")) 171 (check-match '("b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] '(() . "b")) 172 (check-match '(1 1 1 "b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] '((1 1 1) . "b")) 173 (check-match '(1 1 1 "b") [(xlist (? number? n) ^ 1 - (? string? s)) (cons n s)] '((1 1 1) . "b")) 174 (check-match '(1 1 1 "b") [(xlist (? number? n) ^ 2 - (? string? s)) (cons n s)] '((1 1 1) . "b")) 175 (void))