test-match.rkt (10019B)
1 #lang racket 2 3 (require xlist/untyped 4 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 . single-pat)" 24 ;; Need a not-yet-accepted PR in Racket. 25 ;(check-match? '() (xlist . null?)) 26 ;(check-match? '1 (xlist . 1)) 27 ;(check-match? '1 (xlist . number?)) 28 (void)) 29 30 (test-begin 31 "(xlist #:rest . pat)" 32 (check-match '() [(xlist #:rest (? null? v)) v] '()) 33 (check-match '1 [(xlist #:rest (and 1 v)) v] 1) 34 (check-match '1 [(xlist #:rest (? number? v)) v] 1) 35 (check-match #(1 "b") [(xlist #:rest (vector (? number? n) (? string? s))) (cons n s)] '(1 . "b")) 36 (void)) 37 38 (test-begin 39 "(xlist 1 2 3 4 5)" 40 (check-match? '() (xlist)) 41 (check-match? '(1) (xlist 1)) 42 (check-match? '(1 2) (xlist 1 2)) 43 (check-match? '(1 2 3) (xlist 1 2 3)) 44 (check-match? '(1 2 3 4) (xlist 1 2 3 4)) 45 (check-match? '(1 2 3 4 5) (xlist 1 2 3 4 5)) 46 47 (check-not-match? '() (xlist 1)) 48 (check-not-match? '(1) (xlist 1 2)) 49 (check-not-match? '(1 2) (xlist 1 2 3)) 50 (check-not-match? '(1 2 3) (xlist 1 2 3 4)) 51 (check-not-match? '(1 2 3 4) (xlist 1 2 3 4 5)) 52 (check-not-match? '(1 2 3 4 5) (xlist 1 2 3 4 5 6)) 53 54 (check-not-match? '(1) (xlist)) 55 (check-not-match? '(1 2) (xlist 1)) 56 (check-not-match? '(1 2 3) (xlist 1 2)) 57 (check-not-match? '(1 2 3 4) (xlist 1 2 3)) 58 (check-not-match? '(1 2 3 4 5) (xlist 1 2 3 4)) 59 (check-not-match? '(1 2 3 4 5 6) (xlist 1 2 3 4 5)) 60 (void)) 61 62 ;; Should fail: 63 ;(xlist ^ 1) 64 ;(xlist ^ 1 +) 65 ;(xlist ^ 1 *) 66 ;(xlist +) 67 ;(xlist *) 68 69 (test-begin 70 "(xlist 1 *) and (xlist 1 +) with or witout ^" 71 (check-match? '() (xlist 1 *)) 72 (check-match? '(1) (xlist 1 *)) 73 (check-match? '(1 1) (xlist 1 *)) 74 (check-match? '(1 1 1) (xlist 1 *)) 75 76 (check-not-match? '() (xlist 1 +)) 77 (check-match? '(1) (xlist 1 +)) 78 (check-match? '(1 1) (xlist 1 +)) 79 (check-match? '(1 1 1) (xlist 1 +)) 80 81 (check-match? '() (xlist 1 ^ *)) 82 (check-match? '(1) (xlist 1 ^ *)) 83 (check-match? '(1 1) (xlist 1 ^ *)) 84 (check-match? '(1 1 1) (xlist 1 ^ *)) 85 86 (check-not-match? '() (xlist 1 ^ +)) 87 (check-match? '(1) (xlist 1 ^ +)) 88 (check-match? '(1 1) (xlist 1 ^ +)) 89 (check-match? '(1 1 1) (xlist 1 ^ +)) 90 (void)) 91 92 93 (test-begin 94 "(xlist (? number? n) *) and (xlist (? number? n) +) with or witout ^" 95 (check-match '() [(xlist (? number? n) *) n] '()) 96 (check-match '(1) [(xlist (? number? n) *) n] '(1)) 97 (check-match '(1 1) [(xlist (? number? n) *) n] '(1 1)) 98 (check-match '(1 1 1) [(xlist (? number? n) *) n] '(1 1 1)) 99 100 (check-not-match '() [(xlist (? number? n) +) n]) 101 (check-match '(1) [(xlist (? number? n) +) n] '(1)) 102 (check-match '(1 1) [(xlist (? number? n) +) n] '(1 1)) 103 (check-match '(1 1 1) [(xlist (? number? n) +) n] '(1 1 1)) 104 105 (check-match '() [(xlist (? number? n) ^ *) n] '()) 106 (check-match '(1) [(xlist (? number? n) ^ *) n] '(1)) 107 (check-match '(1 1) [(xlist (? number? n) ^ *) n] '(1 1)) 108 (check-match '(1 1 1) [(xlist (? number? n) ^ *) n] '(1 1 1 )) 109 110 (check-not-match '() [(xlist (? number? n) ^ +) n]) 111 (check-match '(1) [(xlist (? number? n) ^ +) n] '(1)) 112 (check-match '(1 1) [(xlist (? number? n) ^ +) n] '(1 1)) 113 (check-match '(1 1 1) [(xlist (? number? n) ^ +) n] '(1 1 1)) 114 (void)) 115 116 (test-begin 117 "(xlist (? number? n) *) and (xlist (? number? n) +) something after" 118 (check-match '() [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ())) 119 (check-match '(1) [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1) . ())) 120 (check-match '("b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ("b"))) 121 (check-match '(1 "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1) . ("b"))) 122 (check-match '(1 1 1 "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1 1 1) . ("b" "b"))) 123 (check-match '(1 1 1) [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1 1 1) . ())) 124 (check-match '("b" "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ("b" "b" "b"))) 125 126 (check-not-match '() [(xlist (? number? n) + (? string? s) +) (cons n s)]) 127 (check-not-match '(1) [(xlist (? number? n) + (? string? s) +) (cons n s)]) 128 (check-not-match '("b") [(xlist (? number? n) + (? string? s) +) (cons n s)]) 129 (check-match '(1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1) . ("b"))) 130 (check-match '(1 1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1 1) . ("b"))) 131 (check-match '(1 "b" "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1) . ("b" "b"))) 132 133 (check-match '() [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ())) 134 (check-match '(1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1) . ())) 135 (check-match '("b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ("b"))) 136 (check-match '(1 "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1) . ("b"))) 137 (check-match '(1 1 1 "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1 1 1) . ("b" "b"))) 138 (check-match '(1 1 1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1 1 1) . ())) 139 (check-match '("b" "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ("b" "b" "b"))) 140 141 (check-not-match '() [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)]) 142 (check-not-match '(1) [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)]) 143 (check-not-match '("b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)]) 144 (check-match '(1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1) . ("b"))) 145 (check-match '(1 1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1 1) . ("b"))) 146 (check-match '(1 "b" "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1) . ("b" "b"))) 147 (void)) 148 149 (test-begin 150 "(xlist (? number? n) ^ x +)" 151 (check-match '(1 1 1) [(xlist (? number? n) +) n] '(1 1 1)) 152 (check-match '(1 1 1) [(xlist (? number? n) ^ +) n] '(1 1 1)) 153 (check-match '(1 1 1) [(xlist (? number? n) ^ 0 +) n] '(1 1 1)) 154 (check-match '(1 1 1) [(xlist (? number? n) ^ 1 +) n] '(1 1 1)) 155 (check-match '(1 1 1) [(xlist (? number? n) ^ 2 +) n] '(1 1 1)) 156 (check-match '(1 1 1) [(xlist (? number? n) ^ 3 +) n] '(1 1 1)) 157 (void)) 158 159 (test-begin 160 "(xlist (? number? n) ^ x - y)" 161 (check-match '() [(xlist (? number? n) ^ -) n] '()) 162 (check-match '(1 1 1) [(xlist (? number? n) ^ -) n] '(1 1 1)) 163 (check-match '() [(xlist (? number? n) ^ 0 -) n] '()) 164 (check-match '(1 1 1) [(xlist (? number? n) ^ 0 -) n] '(1 1 1)) 165 (check-match '(1 1 1) [(xlist (? number? n) ^ 1 -) n] '(1 1 1)) 166 (check-match '(1 1 1) [(xlist (? number? n) ^ 2 -) n] '(1 1 1)) 167 (check-match '(1 1 1) [(xlist (? number? n) ^ 3 -) n] '(1 1 1)) 168 (check-match '() [(xlist (? number? n) ^ - ∞) n] '()) 169 (check-match '(1 1 1) [(xlist (? number? n) ^ - ∞) n] '(1 1 1)) 170 (check-match '() [(xlist (? number? n) ^ 0 - ∞) n] '()) 171 (check-match '(1 1 1) [(xlist (? number? n) ^ 0 - ∞) n] '(1 1 1)) 172 (check-match '(1 1 1) [(xlist (? number? n) ^ 1 - ∞) n] '(1 1 1)) 173 (check-match '(1 1 1) [(xlist (? number? n) ^ 2 - ∞) n] '(1 1 1)) 174 (check-match '(1 1 1) [(xlist (? number? n) ^ 3 - ∞) n] '(1 1 1)) 175 (check-match '(1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1)) 176 (check-match '(1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1)) 177 (check-match '(1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1 1)) 178 (check-match '(1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1 1)) 179 (check-match '(1 1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1 1 1)) 180 (check-match '(1 1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1 1 1)) 181 (void)) 182 183 (test-begin 184 "(xlist (? number? n) ^ x - (? string? s))" 185 (check-match '("b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] '(() . "b")) 186 (check-match '(1 1 1 "b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] '((1 1 1) . "b")) 187 (check-match '("b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] '(() . "b")) 188 (check-match '(1 1 1 "b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] '((1 1 1) . "b")) 189 (check-match '(1 1 1 "b") [(xlist (? number? n) ^ 1 - (? string? s)) (cons n s)] '((1 1 1) . "b")) 190 (check-match '(1 1 1 "b") [(xlist (? number? n) ^ 2 - (? string? s)) (cons n s)] '((1 1 1) . "b")) 191 (void)) 192 193 194 (test-begin 195 "More complex repetitions" 196 (check-match '(1 2 3 d e f 7 8 9) 197 [(xlist (? number? n1) * (? symbol? s) * (? number? n2) *) 198 (list n2 s n1)] 199 '((7 8 9) (d e f) (1 2 3))) 200 (void)) 201 202 (test-begin 203 "{once}, {1} and a simple pattern variable" 204 (check-match '(a a a a a a a a) 205 [(xlist a1 ^ {once} a2 ^ {1} a3 a4 ^ *) 206 (list a4 a3 a2 a1)] 207 '((a a a a a) a (a) a)) 208 (void))