[8991] | 1 | ;-*- Mode: Lisp -*- |
---|
| 2 | ;;;; Author: Paul Dietz |
---|
| 3 | ;;;; Created: Sun Aug 18 10:10:04 2002 |
---|
| 4 | ;;;; Contains: Tests for the MAP-INTO function |
---|
| 5 | |
---|
| 6 | (in-package :cl-test) |
---|
| 7 | |
---|
| 8 | (deftest map-into-list.1 |
---|
| 9 | (let ((a (copy-seq '(a b c d e f))) |
---|
| 10 | (b nil)) |
---|
| 11 | (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6)) |
---|
| 12 | (values a b)) |
---|
| 13 | (1 2 3 4 5 6) |
---|
| 14 | (6 5 4 3 2 1)) |
---|
| 15 | |
---|
| 16 | (deftest map-into-list.2 |
---|
| 17 | (let ((a (copy-seq '(a b c d e f g)))) |
---|
| 18 | (map-into a #'identity '(1 2 3)) |
---|
| 19 | a) |
---|
| 20 | (1 2 3 d e f g)) |
---|
| 21 | |
---|
| 22 | (deftest map-into-list.3 |
---|
| 23 | (let ((a (copy-seq '(a b c)))) |
---|
| 24 | (map-into a #'identity '(1 2 3 4 5 6)) |
---|
| 25 | a) |
---|
| 26 | (1 2 3)) |
---|
| 27 | |
---|
| 28 | (deftest map-into-list.4 |
---|
| 29 | (let ((a (copy-seq '(a b c d e f))) |
---|
| 30 | (b nil)) |
---|
| 31 | (map-into a #'(lambda (x y) (let ((z (+ x y))) (push z b) z)) |
---|
| 32 | '(1 2 3 4 5 6) |
---|
| 33 | '(10 11 12 13 14 15)) |
---|
| 34 | (values a b)) |
---|
| 35 | (11 13 15 17 19 21) |
---|
| 36 | (21 19 17 15 13 11)) |
---|
| 37 | |
---|
| 38 | (deftest map-into-list.5 |
---|
| 39 | (let ((a (copy-seq '(a b c d e f)))) |
---|
| 40 | (map-into a 'identity '(1 2 3 4 5 6)) |
---|
| 41 | a) |
---|
| 42 | (1 2 3 4 5 6)) |
---|
| 43 | |
---|
| 44 | (deftest map-into-list.6 |
---|
| 45 | (let ((b nil)) |
---|
| 46 | (values |
---|
| 47 | (map-into nil #'(lambda (x y) (let ((z (+ x y))) (push z b) z)) |
---|
| 48 | '(1 2 3 4 5 6) |
---|
| 49 | '(10 11 12 13 14 15)) |
---|
| 50 | b)) |
---|
| 51 | nil nil) |
---|
| 52 | |
---|
| 53 | (deftest map-into-list.7 |
---|
| 54 | (let ((a (copy-seq '(a b c d e f)))) |
---|
| 55 | (map-into a #'(lambda () 1)) |
---|
| 56 | a) |
---|
| 57 | (1 1 1 1 1 1)) |
---|
| 58 | |
---|
| 59 | (deftest map-into-list.8 |
---|
| 60 | (let ((a (copy-seq '(a b c d e f))) |
---|
| 61 | (s2 (make-array '(6) :initial-element 'x |
---|
| 62 | :fill-pointer 4))) |
---|
| 63 | (map-into a #'identity s2) |
---|
| 64 | a) |
---|
| 65 | (x x x x e f)) |
---|
| 66 | |
---|
| 67 | (deftest map-into-array.1 |
---|
| 68 | (let ((a (copy-seq #(a b c d e f))) |
---|
| 69 | b) |
---|
| 70 | (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6)) |
---|
| 71 | (values a b)) |
---|
| 72 | #(1 2 3 4 5 6) |
---|
| 73 | (6 5 4 3 2 1)) |
---|
| 74 | |
---|
| 75 | (deftest map-into-array.2 |
---|
| 76 | (let ((a (copy-seq #(a b c d e f g h))) |
---|
| 77 | b) |
---|
| 78 | (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6)) |
---|
| 79 | (values a b)) |
---|
| 80 | #(1 2 3 4 5 6 g h) |
---|
| 81 | (6 5 4 3 2 1)) |
---|
| 82 | |
---|
| 83 | (deftest map-into-array.3 |
---|
| 84 | (let ((a (copy-seq #(a b c d))) |
---|
| 85 | b) |
---|
| 86 | (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6)) |
---|
| 87 | (values a b)) |
---|
| 88 | #(1 2 3 4) |
---|
| 89 | (4 3 2 1)) |
---|
| 90 | |
---|
| 91 | (deftest map-into-array.4 |
---|
| 92 | (let ((a (copy-seq #(a b c d e f))) |
---|
| 93 | b) |
---|
| 94 | (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6)) |
---|
| 95 | (values a b)) |
---|
| 96 | #(1 2 3 4 5 6) |
---|
| 97 | (6 5 4 3 2 1)) |
---|
| 98 | |
---|
| 99 | (deftest map-into-array.5 |
---|
| 100 | (let ((a (copy-seq #(a b c d e f g h))) |
---|
| 101 | b) |
---|
| 102 | (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6)) |
---|
| 103 | (values a b)) |
---|
| 104 | #(1 2 3 4 5 6 g h) |
---|
| 105 | (6 5 4 3 2 1)) |
---|
| 106 | |
---|
| 107 | (deftest map-into-array.6 |
---|
| 108 | (let ((a (copy-seq #(a b c d))) |
---|
| 109 | b) |
---|
| 110 | (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6)) |
---|
| 111 | (values a b)) |
---|
| 112 | #(1 2 3 4) |
---|
| 113 | (4 3 2 1)) |
---|
| 114 | |
---|
| 115 | ;;; Tests of mapping into arrays with fill pointers |
---|
| 116 | (deftest map-into-array.7 |
---|
| 117 | (let ((a (make-array 6 :initial-element 'x |
---|
| 118 | :fill-pointer 3))) |
---|
| 119 | (map-into a #'identity '(1 2 3)) |
---|
| 120 | a) |
---|
| 121 | #(1 2 3)) |
---|
| 122 | |
---|
| 123 | (deftest map-into-array.8 |
---|
| 124 | (let ((a (make-array 6 :initial-element 'x |
---|
| 125 | :fill-pointer 3))) |
---|
| 126 | (map-into a #'identity '(1 2)) |
---|
| 127 | a) |
---|
| 128 | #(1 2)) |
---|
| 129 | |
---|
| 130 | (deftest map-into-array.9 |
---|
| 131 | (let ((a (make-array 6 :initial-element 'x |
---|
| 132 | :fill-pointer 3))) |
---|
| 133 | (map-into a #'identity '(1 2 3 4 5)) |
---|
| 134 | (and (eqlt (fill-pointer a) 5) |
---|
| 135 | a)) |
---|
| 136 | #(1 2 3 4 5)) |
---|
| 137 | |
---|
| 138 | (deftest map-into-array.10 |
---|
| 139 | (let ((a (make-array 6 :initial-element 'x |
---|
| 140 | :fill-pointer 3))) |
---|
| 141 | (map-into a #'(lambda () 'y)) |
---|
| 142 | (and (eqlt (fill-pointer a) 6) |
---|
| 143 | a)) |
---|
| 144 | #(y y y y y y)) |
---|
| 145 | |
---|
| 146 | (deftest map-into-array.11 |
---|
| 147 | (let ((a (copy-seq #(a b c d e f))) |
---|
| 148 | (s2 (make-array '(6) :initial-element 'x |
---|
| 149 | :fill-pointer 4))) |
---|
| 150 | (map-into a #'identity s2) |
---|
| 151 | a) |
---|
| 152 | #(x x x x e f)) |
---|
| 153 | |
---|
| 154 | ;;; mapping into strings |
---|
| 155 | |
---|
| 156 | (deftest map-into-string.1 |
---|
| 157 | (let ((a (copy-seq "abcdef"))) |
---|
| 158 | (map-into a #'identity "123456") |
---|
| 159 | (values (not (not (stringp a))) a)) |
---|
| 160 | t |
---|
| 161 | "123456") |
---|
| 162 | |
---|
| 163 | (deftest map-into-string.2 |
---|
| 164 | (let ((a (copy-seq "abcdef"))) |
---|
| 165 | (map-into a #'identity "1234") |
---|
| 166 | (values (not (not (stringp a))) a)) |
---|
| 167 | t |
---|
| 168 | "1234ef") |
---|
| 169 | |
---|
| 170 | (deftest map-into-string.3 |
---|
| 171 | (let ((a (copy-seq "abcd"))) |
---|
| 172 | (map-into a #'identity "123456") |
---|
| 173 | (values (not (not (stringp a))) a)) |
---|
| 174 | t |
---|
| 175 | "1234") |
---|
| 176 | |
---|
| 177 | (deftest map-into-string.4 |
---|
| 178 | (let ((a (make-array 6 :initial-element #\x |
---|
| 179 | :element-type 'character |
---|
| 180 | :fill-pointer 3))) |
---|
| 181 | (map-into a #'identity "abcde") |
---|
| 182 | (values |
---|
| 183 | (fill-pointer a) |
---|
| 184 | (aref a 5) |
---|
| 185 | a)) |
---|
| 186 | 5 |
---|
| 187 | #\x |
---|
| 188 | "abcde") |
---|
| 189 | |
---|
| 190 | (deftest map-into-string.5 |
---|
| 191 | (let ((a (make-array 6 :initial-element #\x |
---|
| 192 | :element-type 'character |
---|
| 193 | :fill-pointer 3))) |
---|
| 194 | (map-into a #'(lambda () #\y)) |
---|
| 195 | (values (fill-pointer a) |
---|
| 196 | a)) |
---|
| 197 | 6 |
---|
| 198 | "yyyyyy") |
---|
| 199 | |
---|
| 200 | (deftest map-into-string.6 |
---|
| 201 | (let ((a (make-array 6 :initial-element #\x |
---|
| 202 | :element-type 'character))) |
---|
| 203 | (map-into a #'(lambda () #\y)) |
---|
| 204 | a) |
---|
| 205 | "yyyyyy") |
---|
| 206 | |
---|
| 207 | (deftest map-into-string.7 |
---|
| 208 | (let ((a (make-array 6 :initial-element #\x |
---|
| 209 | :element-type 'base-char |
---|
| 210 | :fill-pointer 3))) |
---|
| 211 | (map-into a #'identity "abcde") |
---|
| 212 | (values (fill-pointer a) |
---|
| 213 | (aref a 5) |
---|
| 214 | a)) |
---|
| 215 | 5 |
---|
| 216 | #\x |
---|
| 217 | "abcde") |
---|
| 218 | |
---|
| 219 | (deftest map-into-string.8 |
---|
| 220 | (let ((a (make-array 6 :initial-element #\x |
---|
| 221 | :element-type 'base-char |
---|
| 222 | :fill-pointer 3))) |
---|
| 223 | (map-into a #'(lambda () #\y)) |
---|
| 224 | (values (fill-pointer a) |
---|
| 225 | a)) |
---|
| 226 | 6 |
---|
| 227 | "yyyyyy") |
---|
| 228 | |
---|
| 229 | (deftest map-into-string.9 |
---|
| 230 | (let ((a (make-array 6 :initial-element #\x |
---|
| 231 | :element-type 'base-char))) |
---|
| 232 | (map-into a #'(lambda () #\y)) |
---|
| 233 | a) |
---|
| 234 | "yyyyyy") |
---|
| 235 | |
---|
| 236 | (deftest map-into-string.10 |
---|
| 237 | (let ((a (copy-seq "abcdef")) |
---|
| 238 | (s2 (make-array '(6) :initial-element #\x |
---|
| 239 | :fill-pointer 4))) |
---|
| 240 | (map-into a #'identity s2) |
---|
| 241 | a) |
---|
| 242 | "xxxxef") |
---|
| 243 | |
---|
| 244 | (deftest map-into-string.11 |
---|
| 245 | (let ((a (make-array 6 :initial-element #\x |
---|
| 246 | :element-type 'character |
---|
| 247 | :fill-pointer 3))) |
---|
| 248 | (map-into a #'identity "abcd") |
---|
| 249 | (values |
---|
| 250 | (fill-pointer a) |
---|
| 251 | (aref a 4) |
---|
| 252 | (aref a 5) |
---|
| 253 | a)) |
---|
| 254 | 4 |
---|
| 255 | #\x |
---|
| 256 | #\x |
---|
| 257 | "abcd") |
---|
| 258 | |
---|
| 259 | (deftest map-into-string.12 |
---|
| 260 | (let ((a (make-array 6 :initial-element #\x |
---|
| 261 | :element-type 'character |
---|
| 262 | :fill-pointer 3))) |
---|
| 263 | (map-into a #'identity "abcdefgh") |
---|
| 264 | (values |
---|
| 265 | (fill-pointer a) |
---|
| 266 | a)) |
---|
| 267 | 6 |
---|
| 268 | "abcdef") |
---|
| 269 | |
---|
| 270 | (deftest map-into-string.13 |
---|
| 271 | (do-special-strings |
---|
| 272 | (s (copy-seq "12345") nil) |
---|
| 273 | (let ((s2 (map-into s #'identity "abcde"))) |
---|
| 274 | (assert (eq s s2)) |
---|
| 275 | (assert (string= s2 "abcde")))) |
---|
| 276 | nil) |
---|
| 277 | |
---|
| 278 | (deftest map-into-string.14 |
---|
| 279 | (do-special-strings |
---|
| 280 | (s "abcde" nil) |
---|
| 281 | (let* ((s1 (copy-seq "123456")) |
---|
| 282 | (s2 (map-into s1 #'identity s))) |
---|
| 283 | (assert (eq s1 s2)) |
---|
| 284 | (assert (string= s2 "abcde6")))) |
---|
| 285 | nil) |
---|
| 286 | |
---|
| 287 | ;;; Tests on bit vectors |
---|
| 288 | |
---|
| 289 | (deftest map-into.bit-vector.1 |
---|
| 290 | (let ((v (copy-seq #*0100110))) |
---|
| 291 | (map-into v #'(lambda (x) (- 1 x)) v) |
---|
| 292 | (and (bit-vector-p v) |
---|
| 293 | v)) |
---|
| 294 | #*1011001) |
---|
| 295 | |
---|
| 296 | (deftest map-into.bit-vector.2 |
---|
| 297 | (let ((v (copy-seq #*0100110))) |
---|
| 298 | (map-into v #'(lambda () 0)) |
---|
| 299 | (and (bit-vector-p v) |
---|
| 300 | v)) |
---|
| 301 | #*0000000) |
---|
| 302 | |
---|
| 303 | (deftest map-into.bit-vector.3 |
---|
| 304 | (let ((v (copy-seq #*0100110))) |
---|
| 305 | (map-into v #'identity '(0 1 1 1 0 0 1)) |
---|
| 306 | (and (bit-vector-p v) |
---|
| 307 | v)) |
---|
| 308 | #*0111001) |
---|
| 309 | |
---|
| 310 | (deftest map-into.bit-vector.4 |
---|
| 311 | (let ((v (copy-seq #*0100110))) |
---|
| 312 | (map-into v #'identity '(0 1 1 1)) |
---|
| 313 | (and (bit-vector-p v) |
---|
| 314 | v)) |
---|
| 315 | #*0111110) |
---|
| 316 | |
---|
| 317 | (deftest map-into.bit-vector.5 |
---|
| 318 | (let ((v (copy-seq #*0100110))) |
---|
| 319 | (map-into v #'identity '(0 1 1 1 0 0 1 4 5 6 7)) |
---|
| 320 | (and (bit-vector-p v) |
---|
| 321 | v)) |
---|
| 322 | #*0111001) |
---|
| 323 | |
---|
| 324 | (deftest map-into.bit-vector.6 |
---|
| 325 | (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1) |
---|
| 326 | :fill-pointer 4 |
---|
| 327 | :element-type 'bit))) |
---|
| 328 | (map-into v #'(lambda () 1)) |
---|
| 329 | (and (bit-vector-p v) |
---|
| 330 | v)) |
---|
| 331 | #*11111111) |
---|
| 332 | |
---|
| 333 | (deftest map-into.bit-vector.7 |
---|
| 334 | (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1) |
---|
| 335 | :fill-pointer 4 |
---|
| 336 | :element-type 'bit))) |
---|
| 337 | (map-into v #'identity v) |
---|
| 338 | (and (bit-vector-p v) |
---|
| 339 | v)) |
---|
| 340 | #*0100) |
---|
| 341 | |
---|
| 342 | (deftest map-into.bit-vector.8 |
---|
| 343 | (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1) |
---|
| 344 | :fill-pointer 4 |
---|
| 345 | :element-type 'bit))) |
---|
| 346 | (map-into v #'identity '(1 1 1 1 1 1)) |
---|
| 347 | (and (bit-vector-p v) |
---|
| 348 | (values (fill-pointer v) |
---|
| 349 | v))) |
---|
| 350 | 6 |
---|
| 351 | #*111111) |
---|
| 352 | |
---|
| 353 | (deftest map-into.bit-vector.9 |
---|
| 354 | (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1) |
---|
| 355 | :fill-pointer 4 |
---|
| 356 | :element-type 'bit))) |
---|
| 357 | (map-into v #'identity '(1 1 1 1 1 1 0 0 1 1 1)) |
---|
| 358 | (and (bit-vector-p v) |
---|
| 359 | (values (fill-pointer v) |
---|
| 360 | v))) |
---|
| 361 | 8 |
---|
| 362 | #*11111100) |
---|
| 363 | |
---|
| 364 | ;;; Other specialized vectors |
---|
| 365 | |
---|
| 366 | (deftest map-into.specialized-vector.1 |
---|
| 367 | (do-special-integer-vectors |
---|
| 368 | (v #(1 2 3 4) nil) |
---|
| 369 | (let ((result (list nil nil nil nil))) |
---|
| 370 | (assert (eq (map-into result #'identity v) result)) |
---|
| 371 | (assert (equal result '(1 2 3 4))))) |
---|
| 372 | nil) |
---|
| 373 | |
---|
| 374 | (deftest map-into.specialized-vector.2 |
---|
| 375 | (do-special-integer-vectors |
---|
| 376 | (v #(1 2 3) nil) |
---|
| 377 | (let ((result (list nil nil nil nil))) |
---|
| 378 | (assert (eq (map-into result #'identity v) result)) |
---|
| 379 | (assert (equal result '(1 2 3 nil))))) |
---|
| 380 | nil) |
---|
| 381 | |
---|
| 382 | (deftest map-into.specialized-vector.3 |
---|
| 383 | (do-special-integer-vectors |
---|
| 384 | (v #(1 1 0 1 1) nil) |
---|
| 385 | (let ((result (list nil nil nil nil))) |
---|
| 386 | (assert (eq (map-into result #'identity v) result)) |
---|
| 387 | (assert (equal result '(1 1 0 1))))) |
---|
| 388 | nil) |
---|
| 389 | |
---|
| 390 | (deftest map-into.specialized-vector.4 |
---|
| 391 | (do-special-integer-vectors |
---|
| 392 | (v #(1 2 1 2 2) nil) |
---|
| 393 | (let ((v2 #(2 1 2 2 1))) |
---|
| 394 | (assert (eq (map-into v #'identity v2) v)) |
---|
| 395 | (assert (equalp v #(2 1 2 2 1))))) |
---|
| 396 | nil) |
---|
| 397 | |
---|
| 398 | (deftest map-into.specialized-vector.5 |
---|
| 399 | (let ((len 10)) |
---|
| 400 | (loop for etype in '(short-float single-float double-float long-float) |
---|
| 401 | for vals = (loop for i below len collect (coerce i etype)) |
---|
| 402 | for vec = (make-array len :initial-contents vals :element-type etype) |
---|
| 403 | for target = (loop repeat len collect nil) |
---|
| 404 | for result = (map-into target #'identity vec) |
---|
| 405 | unless (and (eq target result) |
---|
| 406 | (= (length result) len) |
---|
| 407 | (= (length vec) len) |
---|
| 408 | (equal vals result)) |
---|
| 409 | collect (list etype vals vec result))) |
---|
| 410 | nil) |
---|
| 411 | |
---|
| 412 | (deftest map-into.specialized-vector.6 |
---|
| 413 | (let ((len 10)) |
---|
| 414 | (loop for cetype in '(short-float single-float double-float long-float) |
---|
| 415 | for etype = `(complex ,cetype) |
---|
| 416 | for vals = (loop for i from 1 to len collect (complex (coerce i cetype) |
---|
| 417 | (coerce (- i) cetype))) |
---|
| 418 | for vec = (make-array len :initial-contents vals :element-type etype) |
---|
| 419 | for target = (loop repeat len collect nil) |
---|
| 420 | for result = (map-into target #'identity vec) |
---|
| 421 | unless (and (eq target result) |
---|
| 422 | (= (length result) len) |
---|
| 423 | (= (length vec) len) |
---|
| 424 | (equal vals result)) |
---|
| 425 | collect (list etype vals vec result))) |
---|
| 426 | nil) |
---|
| 427 | |
---|
| 428 | (deftest map-into.specialized-vector.7 |
---|
| 429 | (let ((len 10)) |
---|
| 430 | (loop for etype in '(short-float single-float double-float long-float) |
---|
| 431 | for vals = (loop for i below len collect (coerce i etype)) |
---|
| 432 | for target = (make-array len :initial-contents vals :element-type etype) |
---|
| 433 | for result = (map-into target #'identity vals) |
---|
| 434 | unless (and (eq target result) |
---|
| 435 | (= (length result) len) |
---|
| 436 | (every #'= result vals)) |
---|
| 437 | collect (list etype vals result))) |
---|
| 438 | nil) |
---|
| 439 | |
---|
| 440 | (deftest map-into.specialized-vector.8 |
---|
| 441 | (let ((len 10)) |
---|
| 442 | (loop for cetype in '(short-float single-float double-float long-float) |
---|
| 443 | for etype = `(complex ,cetype) |
---|
| 444 | for vals = (loop for i from 1 to len collect (complex (coerce i cetype) |
---|
| 445 | (coerce (- i) cetype))) |
---|
| 446 | for target = (make-array len :initial-contents vals :element-type etype) |
---|
| 447 | for result = (map-into target #'identity vals) |
---|
| 448 | unless (and (eq target result) |
---|
| 449 | (= (length result) len) |
---|
| 450 | (every #'= result vals)) |
---|
| 451 | collect (list etype vals result))) |
---|
| 452 | nil) |
---|
| 453 | |
---|
| 454 | ;;; Error cases |
---|
| 455 | |
---|
| 456 | (deftest map-into.error.1 |
---|
| 457 | (check-type-error #'(lambda (x) (map-into x (constantly nil))) #'sequencep) |
---|
| 458 | nil) |
---|
| 459 | |
---|
| 460 | ;;; The next test was changed because if the first argument |
---|
| 461 | ;;; is NIL, map-into is said to 'return nil immediately', so |
---|
| 462 | ;;; the 'should be prepared' notation for the error checking |
---|
| 463 | ;;; means that error checking may be skipped. |
---|
| 464 | (deftest map-into.error.2 |
---|
| 465 | (and (locally (declare (optimize (safety 3))) |
---|
| 466 | (handler-case (eval '(map-into nil #'identity 'a)) |
---|
| 467 | (type-error () nil))) |
---|
| 468 | :bad) |
---|
| 469 | nil) |
---|
| 470 | |
---|
| 471 | (deftest map-into.error.3 |
---|
| 472 | (check-type-error #'(lambda (x) (map-into (copy-seq '(a b c)) #'cons '(d e f) x)) |
---|
| 473 | #'sequencep) |
---|
| 474 | nil) |
---|
| 475 | |
---|
| 476 | (deftest map-into.error.4 |
---|
| 477 | (signals-error (map-into) program-error) |
---|
| 478 | t) |
---|
| 479 | |
---|
| 480 | (deftest map-into.error.5 |
---|
| 481 | (signals-error (map-into (list 'a 'b 'c)) program-error) |
---|
| 482 | t) |
---|
| 483 | |
---|
| 484 | (deftest map-into.error.6 |
---|
| 485 | (signals-error (locally (map-into 'a #'(lambda () nil)) t) |
---|
| 486 | type-error) |
---|
| 487 | t) |
---|
| 488 | |
---|
| 489 | (deftest map-into.error.7 |
---|
| 490 | (signals-error (map-into (list 'a 'b 'c) #'cons '(a b c)) program-error) |
---|
| 491 | t) |
---|
| 492 | |
---|
| 493 | (deftest map-into.error.8 |
---|
| 494 | (signals-error (map-into (list 'a 'b 'c) #'car '(a b c)) type-error) |
---|
| 495 | t) |
---|
| 496 | |
---|
| 497 | ;;; Order of evaluation tests |
---|
| 498 | |
---|
| 499 | (deftest map-into.order.1 |
---|
| 500 | (let ((i 0) a b c) |
---|
| 501 | (values |
---|
| 502 | (map-into (progn (setf a (incf i)) (list 1 2 3 4)) |
---|
| 503 | (progn (setf b (incf i)) #'identity) |
---|
| 504 | (progn (setf c (incf i)) '(a b c d))) |
---|
| 505 | i a b c)) |
---|
| 506 | (a b c d) 3 1 2 3) |
---|
| 507 | |
---|
| 508 | (deftest map-into.order.2 |
---|
| 509 | (let ((i 0) a b c d) |
---|
| 510 | (values |
---|
| 511 | (map-into (progn (setf a (incf i)) (list 1 2 3 4)) |
---|
| 512 | (progn (setf b (incf i)) #'list) |
---|
| 513 | (progn (setf c (incf i)) '(a b c d)) |
---|
| 514 | (progn (setf d (incf i)) '(e f g h))) |
---|
| 515 | i a b c d)) |
---|
| 516 | ((a e) (b f) (c g) (d h)) 4 1 2 3 4) |
---|