tables.k (8796B)
1 ;; check.k & test-helpers.k should be loaded 2 ;; 3 ;; Tests of hash table features. 4 ;; 5 6 ;; XXX make-hash-table hash-table? 7 8 ($check-predicate (applicative? hash-table? make-hash-table)) 9 ($check-predicate (hash-table?)) 10 ($check-predicate (hash-table? (make-hash-table))) 11 12 ($check-not-predicate (hash-table? 0)) 13 ($check-not-predicate (hash-table? "")) 14 ($check-not-predicate (hash-table? ())) 15 ($check-not-predicate (hash-table? (make-bytevector 0))) 16 ($check-not-predicate (hash-table? (make-vector 1))) 17 ($check-not-predicate (hash-table? (make-environment))) 18 19 ($check-error (make-hash-table eq?)) 20 ($check-error (make-hash-table 32)) 21 ($check-error (make-hash-table ($lambda (x) 1))) 22 23 ;; XXX hash-table-set! hash-table-ref hash-table-exists? hash-table-delete! 24 25 ($check-predicate 26 (applicative? hash-table-set! hash-table-ref 27 hash-table-exists? hash-table-delete!)) 28 29 ($check equal? 30 ($let ((t (make-hash-table))) 31 (hash-table-set! t 0 "a") 32 (hash-table-set! t 1 "b") 33 (hash-table-set! t -30 "c") 34 (hash-table-set! t "x" "y") 35 (hash-table-set! t #\u 15) 36 (hash-table-set! t #:kwd 42) 37 (hash-table-set! t #t #f) 38 (hash-table-set! t #inert #\i) 39 (list 40 (map ($lambda (k) (hash-table-ref t k)) 41 (list -30 #:kwd 0 1 #t #\u #inert)) 42 (list 43 (hash-table-exists? t 0 1 #t) 44 (hash-table-exists? t) 45 (hash-table-exists? t #inert #ignore)))) 46 (list 47 (list "c" 42 "a" "b" #f 15 #\i) 48 (list #t #t #f))) 49 50 ($check equal? 51 ($let ((t (make-hash-table))) 52 (hash-table-set! t 42 "a") 53 (hash-table-set! t 13 "b") 54 (hash-table-set! t -5 "c") 55 (hash-table-set! t 42 "d") 56 (hash-table-set! t 13 "e") 57 (list 58 (hash-table-ref t 13) 59 (hash-table-ref t 42) 60 (hash-table-exists? t 0) 61 (hash-table-exists? t -5))) 62 (list "e" "d" #f #t)) 63 64 ($check equal? 65 ($let ((t (make-hash-table))) 66 (hash-table-set! t 42 "a") 67 (hash-table-delete! t 13) 68 (hash-table-delete! t 42 13) 69 (hash-table-set! t 13 "c") 70 (list (hash-table-ref t 13) (hash-table-exists? t 42))) 71 (list "c" #f)) 72 73 ($check equal? 74 ($let 75 ((vx ($vau () denv ($binds? denv x))) 76 (vy ($vau () denv ($binds? denv y)))) 77 ($let ((t (make-hash-table)) (x -5)) 78 (list 79 (hash-table-ref t "a" ($lambda () "d")) 80 (hash-table-ref t "b" vx) 81 (hash-table-ref t "c" vy)))) 82 (list "d" #t #f)) 83 84 ($check-error (hash-table-ref (make-hash-table) 0)) 85 ($check-error 86 ($let ((t (make-hash-table))) 87 (hash-table-set! t "a" "b") 88 (hash-table-ref t "b"))) 89 90 ($let ((t (make-hash-table))) 91 (hash-table-set! t 3 "x") 92 ($check-error (hash-table-ref)) 93 ($check-error (hash-table-ref () 2)) 94 ($check-error (hash-table-ref t)) 95 ($check-error (hash-table-ref t 2)) 96 ($check-no-error (hash-table-ref t 3)) 97 ($check-error (hash-table-ref t 3 5)) 98 ($check-error (apply hash-table-ref (list* t 3 ($lambda () ())))) 99 ($check-error (hash-table-ref t 3 ($lambda () ()) 5)) 100 ($check-error (hash-table-set!)) 101 ($check-error (hash-table-set! t)) 102 ($check-error (hash-table-set! t 1)) 103 ($check-no-error (hash-table-set! t 1 2)) 104 ($check-error (hash-table-set! () 1 2)) 105 ($check-error (hash-table-set! t 1 3 4)) 106 ($check-error (hash-table-exists?)) 107 ($check-no-error (hash-table-exists? t)) 108 ($check-error (hash-table-exists? ())) 109 ($check-error (hash-table-delete!)) 110 ($check-error (hash-table-delete! () 1 2 3)) 111 ($check-no-error (hash-table-delete! t))) 112 113 ;; XXX hash-table-length 114 115 ($check-predicate (applicative? hash-table-length)) 116 ($check equal? (hash-table-length (make-hash-table)) 0) 117 ($check equal? 118 ($let ((t (make-hash-table))) 119 (hash-table-set! t "a" "b") 120 (hash-table-set! t "c" "d") 121 (hash-table-set! t "e" "f") 122 (hash-table-delete! t "c") 123 (hash-table-length t)) 124 2) 125 ($check-error (hash-table-length)) 126 ($check-error (hash-table-length ())) 127 ($check-error (apply hash-table-length 1)) 128 ($check-error (hash-table-length (make-hash-table) (make-hash-table))) 129 130 ;; XXX hash-table 131 132 ($check-predicate (applicative? hash-table)) 133 ($check-predicate (hash-table? (hash-table))) 134 ($check equal? 135 ($let ((t (hash-table 0 #f 1 #t))) 136 (list 137 (hash-table? t) 138 (hash-table-length t) 139 (hash-table-exists? t 0) 140 (hash-table-exists? t 1) 141 (hash-table-exists? t 2) 142 (hash-table-ref t 0) 143 (hash-table-ref t 1))) 144 (list #t 2 #t #t #f #f #t)) 145 146 ($check-error (hash-table 1)) 147 ($check-error (hash-table 1 2 3)) 148 ($check-error (hash-table 1 2 3 4 5)) 149 ($check-error 150 ($let ((ls (list 1 2 3 4 5 6))) 151 (encycle! ls 3 3) 152 (apply hash-table ls))) 153 154 ;; XXX alist->hash-table 155 156 ($check-predicate (applicative? alist->hash-table)) 157 ($check-predicate (hash-table? (alist->hash-table ()))) 158 ($check equal? 159 ($let 160 ((t 161 (alist->hash-table 162 ($quote (("x" . "y") (1 . 2) (3 . 4)))))) 163 (list 164 (hash-table? t) 165 (hash-table-length t) 166 (hash-table-exists? t "x") 167 (hash-table-exists? t "y") 168 (hash-table-exists? t 1) 169 (hash-table-exists? t 2) 170 (hash-table-ref t 1) 171 (hash-table-ref t 3))) 172 (list #t 3 #t #f #t #f 2 4)) 173 174 ($check-no-error (alist->hash-table ())) 175 ($check-error (alist->hash-table)) 176 ($check-error (alist->hash-table () ())) 177 ($check-error ((unwrap alist->hash-table) 0)) 178 ($check-error (alist->hash-table 1)) 179 ($check-error (alist->hash-table (list 1 2))) 180 ($check-error (alist->hash-table (list (cons 1 2) 3))) 181 182 ;; XXX hash-table-keys hash-table-values hash-table->alist 183 184 ($provide! (list-set-equal?) 185 ($define! list-subset? 186 ($lambda (a b) 187 ($if (null? a) 188 #t 189 ($and? (member? (car a) b) (list-subset? (cdr a) b))))) 190 ($define! list-set-equal? 191 ($lambda (a b) 192 ($and? 193 (=? (length a) (length b)) 194 (list-subset? a b) 195 (list-subset? b a))))) 196 197 ($check-predicate 198 (applicative? hash-table-keys hash-table-values hash-table->alist)) 199 200 ($check list-set-equal? 201 (hash-table-keys (hash-table "a" 1 "b" 2 "c" 3)) 202 (list "a" "b" "c")) 203 204 ($check list-set-equal? 205 (hash-table-values (hash-table "a" 1 "b" 2 "c" 3)) 206 (list 1 2 3)) 207 208 ($check list-set-equal? 209 (hash-table->alist (hash-table "a" 1 "b" 2 "c" 3)) 210 (list (cons "a" 1) (cons "b" 2) (cons "c" 3))) 211 212 ($let ((t (hash-table 1 2 3 4))) 213 ($check-error (hash-table-keys)) 214 ($check-error (hash-table-keys ())) 215 ($check-error (hash-table-keys t t)) 216 ($check-error (hash-table-values)) 217 ($check-error (hash-table-values ())) 218 ($check-error (hash-table-values t t)) 219 ($check-error (hash-table->alist)) 220 ($check-error (hash-table->alist ())) 221 ($check-error (hash-table->alist t t))) 222 223 ;; XXX hash-table-merge hash-table-copy hash-table-merge! 224 225 ($check-predicate 226 (applicative? hash-table-merge hash-table-copy hash-table-merge!)) 227 228 ($check equal? 229 (hash-table->alist (hash-table-merge)) 230 ()) 231 232 ($check list-set-equal? 233 (hash-table->alist 234 (hash-table-merge 235 (hash-table 1 "a" 2 "b") 236 (hash-table 1 "c" 3 "d") 237 (hash-table 1 "f" 5 "z"))) 238 (list (cons 1 "f") (cons 2 "b") (cons 3 "d") (cons 5 "z"))) 239 240 ($check list-set-equal? 241 (hash-table->alist 242 (hash-table-copy 243 (hash-table 1 "a" 2 "b"))) 244 (list (cons 1 "a") (cons 2 "b"))) 245 246 ($check list-set-equal? 247 ($let ((t (hash-table 1 "a" 2 "b"))) 248 (hash-table-merge! t (hash-table "x" "y" 2 "w")) 249 (hash-table->alist t)) 250 (list 251 (cons 1 "a") (cons 2 "w") (cons "x" "y"))) 252 253 ($check equal? 254 ($let* 255 ((t1 (hash-table 1 "a" 2 "b")) 256 (t2 (hash-table 2 "c" 3 "d")) 257 (t3 (hash-table-merge t1 t2)) 258 (t4 (hash-table-copy t2))) 259 (list 260 (eq? t1 t2) (eq? t1 t3) (eq? t1 t4) 261 (eq? t2 t3) (eq? t2 t4) 262 (eq? t3 t4))) 263 (list #f #f #f #f #f #f)) 264 265 ($let* 266 ((t (hash-table 1 2 3 4)) 267 (ls1 (list t)) 268 (ls2 (list t t))) 269 (encycle! ls1 0 1) 270 (encycle! ls2 1 1) 271 ($check-no-error (hash-table-merge)) 272 ($check-no-error (hash-table-merge t)) 273 ($check-error (hash-table-merge t ())) 274 ($check-error (hash-table-merge () t)) 275 ($check-no-error (hash-table-merge t t t t)) 276 ($check-no-error (apply hash-table-merge ls1)) 277 ($check-no-error (apply hash-table-merge ls2)) 278 ($check-error ((unwrap hash-table-merge) 1)) 279 ($check-error (hash-table-merge!)) 280 ($check-no-error (hash-table-merge! t)) 281 ($check-error (hash-table-merge! t ())) 282 ($check-error (hash-table-merge! () t)) 283 ($check-no-error (hash-table-merge! t t t t)) 284 ($check-no-error (apply hash-table-merge! ls1)) 285 ($check-no-error (apply hash-table-merge! ls2)) 286 ($check-error ((unwrap hash-table-merge!) 1)) 287 ($check-error (hash-table-copy)) 288 ($check-no-error (hash-table-copy t)) 289 ($check-error (hash-table-copy t ())) 290 ($check-error (hash-table-copy () t)) 291 ($check-no-error (apply hash-table-copy ls1)) 292 ($check-error (apply hash-table-copy ls2)) 293 ($check-error (hash-table-copy t t t t)) 294 ($check-error ((unwrap hash-table-copy) 1)))