1;;;; srfi-43.test --- test suite for SRFI-43 Vector library -*- scheme -*- 2;;;; 3;;;; Copyright (C) 2014 Free Software Foundation, Inc. 4;;;; 5;;;; This library is free software; you can redistribute it and/or 6;;;; modify it under the terms of the GNU Lesser General Public 7;;;; License as published by the Free Software Foundation; either 8;;;; version 3 of the License, or (at your option) any later version. 9;;;; 10;;;; This library is distributed in the hope that it will be useful, 11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13;;;; Lesser General Public License for more details. 14;;;; 15;;;; You should have received a copy of the GNU Lesser General Public 16;;;; License along with this library; if not, write to the Free Software 17;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18 19;;; 20;;; Originally written by Shiro Kawai and placed in the public domain 21;;; 10/5/2005. 22;;; 23;;; Many tests added, and adapted for Guile's (test-suite lib) 24;;; by Mark H Weaver <mhw@netris.org>, Jan 2014. 25;;; 26 27(define-module (test-suite test-srfi-43) 28 #:use-module (srfi srfi-43) 29 #:use-module (test-suite lib)) 30 31(define-syntax-rule (pass-if-error name body0 body ...) 32 (pass-if name 33 (catch #t 34 (lambda () body0 body ... #f) 35 (lambda (key . args) #t)))) 36 37;;; 38;;; Constructors 39;;; 40 41;; 42;; make-vector 43;; 44 45(with-test-prefix "make-vector" 46 47 (pass-if-equal "simple, no init" 48 5 49 (vector-length (make-vector 5))) 50 51 (pass-if-equal "empty" 52 '#() 53 (make-vector 0)) 54 55 (pass-if-error "negative length" 56 (make-vector -4)) 57 58 (pass-if-equal "simple with init" 59 '#(3 3 3 3 3) 60 (make-vector 5 3)) 61 62 (pass-if-equal "empty with init" 63 '#() 64 (make-vector 0 3)) 65 66 (pass-if-error "negative length" 67 (make-vector -1 3))) 68 69;; 70;; vector 71;; 72 73(with-test-prefix "vector" 74 75 (pass-if-equal "no args" 76 '#() 77 (vector)) 78 79 (pass-if-equal "simple" 80 '#(1 2 3 4 5) 81 (vector 1 2 3 4 5))) 82 83;; 84;; vector-unfold 85;; 86 87(with-test-prefix "vector-unfold" 88 89 (pass-if-equal "no seeds" 90 '#(0 1 2 3 4 5 6 7 8 9) 91 (vector-unfold values 10)) 92 93 (pass-if-equal "no seeds, zero len" 94 '#() 95 (vector-unfold values 0)) 96 97 (pass-if-error "no seeds, negative len" 98 (vector-unfold values -1)) 99 100 (pass-if-equal "1 seed" 101 '#(0 -1 -2 -3 -4 -5 -6 -7 -8 -9) 102 (vector-unfold (lambda (i x) (values x (- x 1))) 103 10 0)) 104 105 (pass-if-equal "1 seed, zero len" 106 '#() 107 (vector-unfold values 0 1)) 108 109 (pass-if-error "1 seed, negative len" 110 (vector-unfold values -2 1)) 111 112 (pass-if-equal "2 seeds" 113 '#((0 20) (-1 21) (-2 22) (-3 23) (-4 24) 114 (-5 25) (-6 26) (-7 27) (-8 28) (-9 29)) 115 (vector-unfold (lambda (i x y) (values (list x y) (- x 1) (+ y 1))) 116 10 0 20)) 117 118 (pass-if-equal "2 seeds, zero len" 119 '#() 120 (vector-unfold values 0 1 2)) 121 122 (pass-if-error "2 seeds, negative len" 123 (vector-unfold values -2 1 2)) 124 125 (pass-if-equal "3 seeds" 126 '#((0 20 30) (-1 21 32) (-2 22 34) (-3 23 36) (-4 24 38) 127 (-5 25 40) (-6 26 42) (-7 27 44) (-8 28 46) (-9 29 48)) 128 (vector-unfold (lambda (i x y z) 129 (values (list x y z) (- x 1) (+ y 1) (+ z 2))) 130 10 0 20 30)) 131 132 (pass-if-equal "3 seeds, zero len" 133 '#() 134 (vector-unfold values 0 1 2 3)) 135 136 (pass-if-error "3 seeds, negative len" 137 (vector-unfold values -2 1 2 3))) 138 139;; 140;; vector-unfold-right 141;; 142 143(with-test-prefix "vector-unfold-right" 144 145 (pass-if-equal "no seeds, zero len" 146 '#() 147 (vector-unfold-right values 0)) 148 149 (pass-if-error "no seeds, negative len" 150 (vector-unfold-right values -1)) 151 152 (pass-if-equal "1 seed" 153 '#(9 8 7 6 5 4 3 2 1 0) 154 (vector-unfold-right (lambda (i x) (values x (+ x 1))) 10 0)) 155 156 (pass-if-equal "1 seed, zero len" 157 '#() 158 (vector-unfold-right values 0 1)) 159 160 (pass-if-error "1 seed, negative len" 161 (vector-unfold-right values -1 1)) 162 163 (pass-if-equal "1 seed, reverse vector" 164 '#(e d c b a) 165 (let ((vector '#(a b c d e))) 166 (vector-unfold-right 167 (lambda (i x) (values (vector-ref vector x) (+ x 1))) 168 (vector-length vector) 169 0))) 170 171 (pass-if-equal "2 seeds" 172 '#((0 20) (-1 21) (-2 22) (-3 23) (-4 24) 173 (-5 25) (-6 26) (-7 27) (-8 28) (-9 29)) 174 (vector-unfold-right (lambda (i x y) (values (list x y) (+ x 1) (- y 1))) 175 10 -9 29)) 176 177 (pass-if-equal "2 seeds, zero len" 178 '#() 179 (vector-unfold-right values 0 1 2)) 180 181 (pass-if-error "2 seeds, negative len" 182 (vector-unfold-right values -1 1 2)) 183 184 (pass-if-equal "3 seeds" 185 '#((0 20 30) (-1 21 32) (-2 22 34) (-3 23 36) (-4 24 38) 186 (-5 25 40) (-6 26 42) (-7 27 44) (-8 28 46) (-9 29 48)) 187 (vector-unfold-right (lambda (i x y z) 188 (values (list x y z) (+ x 1) (- y 1) (- z 2))) 189 10 -9 29 48)) 190 191 (pass-if-equal "3 seeds, zero len" 192 '#() 193 (vector-unfold-right values 0 1 2 3)) 194 195 (pass-if-error "3 seeds, negative len" 196 (vector-unfold-right values -1 1 2 3))) 197 198;; 199;; vector-copy 200;; 201 202(with-test-prefix "vector-copy" 203 204 (pass-if-equal "1 arg" 205 '#(a b c d e f g h i) 206 (vector-copy '#(a b c d e f g h i))) 207 208 (pass-if-equal "2 args" 209 '#(g h i) 210 (vector-copy '#(a b c d e f g h i) 6)) 211 212 (pass-if-equal "3 args" 213 '#(d e f) 214 (vector-copy '#(a b c d e f g h i) 3 6)) 215 216 (pass-if-equal "4 args" 217 '#(g h i x x x) 218 (vector-copy '#(a b c d e f g h i) 6 12 'x)) 219 220 (pass-if-equal "3 args, empty range" 221 '#() 222 (vector-copy '#(a b c d e f g h i) 6 6)) 223 224 (pass-if-error "3 args, invalid range" 225 (vector-copy '#(a b c d e f g h i) 4 2))) 226 227;; 228;; vector-reverse-copy 229;; 230 231(with-test-prefix "vector-reverse-copy" 232 233 (pass-if-equal "1 arg" 234 '#(e d c b a) 235 (vector-reverse-copy '#(a b c d e))) 236 237 (pass-if-equal "2 args" 238 '#(e d c) 239 (vector-reverse-copy '#(a b c d e) 2)) 240 241 (pass-if-equal "3 args" 242 '#(d c b) 243 (vector-reverse-copy '#(a b c d e) 1 4)) 244 245 (pass-if-equal "3 args, empty result" 246 '#() 247 (vector-reverse-copy '#(a b c d e) 1 1)) 248 249 (pass-if-error "2 args, invalid range" 250 (vector-reverse-copy '#(a b c d e) 2 1))) 251 252;; 253;; vector-append 254;; 255 256(with-test-prefix "vector-append" 257 258 (pass-if-equal "no args" 259 '#() 260 (vector-append)) 261 262 (pass-if-equal "1 arg" 263 '(#(1 2) #f) 264 (let* ((v (vector 1 2)) 265 (v-copy (vector-append v))) 266 (list v-copy (eq? v v-copy)))) 267 268 (pass-if-equal "2 args" 269 '#(x y) 270 (vector-append '#(x) '#(y))) 271 272 (pass-if-equal "3 args" 273 '#(x y x y x y) 274 (let ((v '#(x y))) 275 (vector-append v v v))) 276 277 (pass-if-equal "3 args with empty vector" 278 '#(x y) 279 (vector-append '#(x) '#() '#(y))) 280 281 (pass-if-error "3 args with non-vectors" 282 (vector-append '#() 'b 'c))) 283 284;; 285;; vector-concatenate 286;; 287 288(with-test-prefix "vector-concatenate" 289 290 (pass-if-equal "2 vectors" 291 '#(a b c d) 292 (vector-concatenate '(#(a b) #(c d)))) 293 294 (pass-if-equal "no vectors" 295 '#() 296 (vector-concatenate '())) 297 298 (pass-if-error "non-vector in list" 299 (vector-concatenate '(#(a b) c)))) 300 301;;; 302;;; Predicates 303;;; 304 305;; 306;; vector? 307;; 308 309(with-test-prefix "vector?" 310 (pass-if "empty vector" (vector? '#())) 311 (pass-if "simple" (vector? '#(a b))) 312 (pass-if "list" (not (vector? '(a b)))) 313 (pass-if "symbol" (not (vector? 'a)))) 314 315;; 316;; vector-empty? 317;; 318 319(with-test-prefix "vector-empty?" 320 (pass-if "empty vector" (vector-empty? '#())) 321 (pass-if "singleton vector" (not (vector-empty? '#(a)))) 322 (pass-if-error "non-vector" (vector-empty 'a))) 323 324;; 325;; vector= 326;; 327 328(with-test-prefix "vector=" 329 330 (pass-if "2 equal vectors" 331 (vector= eq? '#(a b c d) '#(a b c d))) 332 333 (pass-if "3 equal vectors" 334 (vector= eq? '#(a b c d) '#(a b c d) '#(a b c d))) 335 336 (pass-if "2 empty vectors" 337 (vector= eq? '#() '#())) 338 339 (pass-if "no vectors" 340 (vector= eq?)) 341 342 (pass-if "1 vector" 343 (vector= eq? '#(a))) 344 345 (pass-if "2 unequal vectors of equal length" 346 (not (vector= eq? '#(a b c d) '#(a b d c)))) 347 348 (pass-if "3 unequal vectors of equal length" 349 (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b d c)))) 350 351 (pass-if "2 vectors of unequal length" 352 (not (vector= eq? '#(a b c) '#(a b c d)))) 353 354 (pass-if "3 vectors of unequal length" 355 (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b c)))) 356 357 (pass-if "2 vectors: empty, non-empty" 358 (not (vector= eq? '#() '#(a b d c)))) 359 360 (pass-if "2 vectors: non-empty, empty" 361 (not (vector= eq? '#(a b d c) '#()))) 362 363 (pass-if "2 equal vectors, elt= is equal?" 364 (vector= equal? '#("a" "b" "c") '#("a" "b" "c"))) 365 366 (pass-if "2 equal vectors, elt= is =" 367 (vector= = '#(1/2 1/3 1/4 1/5) '#(1/2 1/3 1/4 1/5))) 368 369 (pass-if-error "vector and list" 370 (vector= equal? '#("a" "b" "c") '("a" "b" "c"))) 371 372 (pass-if-error "non-procedure" 373 (vector= 1 '#("a" "b" "c") '("a" "b" "c")))) 374 375;;; 376;;; Selectors 377;;; 378 379;; 380;; vector-ref 381;; 382 383(with-test-prefix "vector-ref" 384 (pass-if-equal "simple 0" 'a (vector-ref '#(a b c) 0)) 385 (pass-if-equal "simple 1" 'b (vector-ref '#(a b c) 1)) 386 (pass-if-equal "simple 2" 'c (vector-ref '#(a b c) 2)) 387 (pass-if-error "negative index" (vector-ref '#(a b c) -1)) 388 (pass-if-error "index beyond end" (vector-ref '#(a b c) 3)) 389 (pass-if-error "empty vector" (vector-ref '#() 0)) 390 (pass-if-error "non-vector" (vector-ref '(a b c) 0)) 391 (pass-if-error "inexact index" (vector-ref '#(a b c) 1.0))) 392 393;; 394;; vector-length 395;; 396 397(with-test-prefix "vector-length" 398 (pass-if-equal "empty vector" 0 (vector-length '#())) 399 (pass-if-equal "simple" 3 (vector-length '#(a b c))) 400 (pass-if-error "non-vector" (vector-length '(a b c)))) 401 402;;; 403;;; Iteration 404;;; 405 406;; 407;; vector-fold 408;; 409 410(with-test-prefix "vector-fold" 411 412 (pass-if-equal "1 vector" 413 10 414 (vector-fold (lambda (i seed val) (+ seed val)) 415 0 416 '#(0 1 2 3 4))) 417 418 (pass-if-equal "1 empty vector" 419 'a 420 (vector-fold (lambda (i seed val) (+ seed val)) 421 'a 422 '#())) 423 424 (pass-if-equal "1 vector, use index" 425 30 426 (vector-fold (lambda (i seed val) (+ seed (* i val))) 427 0 428 '#(0 1 2 3 4))) 429 430 (pass-if-equal "2 vectors, unequal lengths" 431 '(1 -7 1 -1) 432 (vector-fold (lambda (i seed x y) (cons (- x y) seed)) 433 '() 434 '#(6 1 2 3 4) '#(7 0 9 2))) 435 436 (pass-if-equal "3 vectors, unequal lengths" 437 '(51 33 31 19) 438 (vector-fold (lambda (i seed x y z) (cons (- x y z) seed)) 439 '() 440 '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70))) 441 442 (pass-if-error "5 args, non-vector" 443 (vector-fold (lambda (i seed x y z) (cons (- x y z) seed)) 444 '() 445 '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70))) 446 447 (pass-if-error "non-procedure" 448 (vector-fold 1 '() '#(6 1 2 3 4) '#(7 0 9 2)))) 449 450;; 451;; vector-fold-right 452;; 453 454(with-test-prefix "vector-fold-right" 455 456 (pass-if-equal "1 vector" 457 '((0 . a) (1 . b) (2 . c) (3 . d) (4 . e)) 458 (vector-fold-right (lambda (i seed val) (cons (cons i val) seed)) 459 '() 460 '#(a b c d e))) 461 462 (pass-if-equal "2 vectors, unequal lengths" 463 '(-1 1 -7 1) 464 (vector-fold-right (lambda (i seed x y) (cons (- x y) seed)) 465 '() 466 '#(6 1 2 3 7) '#(7 0 9 2))) 467 468 (pass-if-equal "3 vectors, unequal lengths" 469 '(19 31 33 51) 470 (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed)) 471 '() 472 '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70))) 473 474 (pass-if-error "5 args, non-vector" 475 (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed)) 476 '() 477 '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70))) 478 479 (pass-if-error "non-procedure" 480 (vector-fold-right 1 '() '#(6 1 2 3 4) '#(7 0 9 2)))) 481 482;; 483;; vector-map 484;; 485 486(with-test-prefix "vector-map" 487 488 (pass-if-equal "1 vector" 489 '#((0 . a) (1 . b) (2 . c) (3 . d) (4 . e)) 490 (vector-map cons '#(a b c d e))) 491 492 (pass-if-equal "1 empty vector" 493 '#() 494 (vector-map cons '#())) 495 496 (pass-if-equal "2 vectors, unequal lengths" 497 '#(5 8 11 14) 498 (vector-map + '#(0 1 2 3 4) '#(5 6 7 8))) 499 500 (pass-if-equal "3 vectors, unequal lengths" 501 '#(15 28 41 54) 502 (vector-map + '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60))) 503 504 (pass-if-error "4 args, non-vector" 505 (vector-map + '#(0 1 2 3 4) '(5 6 7 8) '#(10 20 30 40 50 60))) 506 507 (pass-if-error "3 args, non-vector" 508 (vector-map + '#(0 1 2 3 4) '(5 6 7 8))) 509 510 (pass-if-error "non-procedure" 511 (vector-map #f '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60)))) 512 513;; 514;; vector-map! 515;; 516 517(with-test-prefix "vector-map!" 518 519 (pass-if-equal "1 vector" 520 '#(0 1 4 9 16) 521 (let ((v (vector 0 1 2 3 4))) 522 (vector-map! * v) 523 v)) 524 525 (pass-if-equal "1 empty vector" 526 '#() 527 (let ((v (vector))) 528 (vector-map! * v) 529 v)) 530 531 (pass-if-equal "2 vectors, unequal lengths" 532 '#(5 8 11 14 4) 533 (let ((v (vector 0 1 2 3 4))) 534 (vector-map! + v '#(5 6 7 8)) 535 v)) 536 537 (pass-if-equal "3 vectors, unequal lengths" 538 '#(15 28 41 54 4) 539 (let ((v (vector 0 1 2 3 4))) 540 (vector-map! + v '#(5 6 7 8) '#(10 20 30 40 50 60)) 541 v)) 542 543 (pass-if-error "non-vector" 544 (let ((v (vector 0 1 2 3 4))) 545 (vector-map! + v '#(5 6 7 8) '(10 20 30 40 50 60)) 546 v)) 547 548 (pass-if-error "non-procedure" 549 (let ((v (vector 0 1 2 3 4))) 550 (vector-map! '(1 . 2) v '#(5 6 7 8) '#(10 20 30 40 50 60)) 551 v))) 552 553;; 554;; vector-for-each 555;; 556 557(with-test-prefix "vector-for-each" 558 559 (pass-if-equal "1 vector" 560 '(4 6 6 4 0) 561 (let ((lst '())) 562 (vector-for-each (lambda (i x) 563 (set! lst (cons (* i x) lst))) 564 '#(5 4 3 2 1)) 565 lst)) 566 567 (pass-if-equal "1 empty vector" 568 '() 569 (let ((lst '())) 570 (vector-for-each (lambda (i x) 571 (set! lst (cons (* i x) lst))) 572 '#()) 573 lst)) 574 575 (pass-if-equal "2 vectors, unequal lengths" 576 '(13 11 7 2) 577 (let ((lst '())) 578 (vector-for-each (lambda (i x y) 579 (set! lst (cons (+ (* i x) y) lst))) 580 '#(5 4 3 2 1) 581 '#(2 3 5 7)) 582 lst)) 583 584 (pass-if-equal "3 vectors, unequal lengths" 585 '(-6 -6 -6 -9) 586 (let ((lst '())) 587 (vector-for-each (lambda (i x y z) 588 (set! lst (cons (+ (* i x) (- y z)) lst))) 589 '#(5 4 3 2 1) 590 '#(2 3 5 7) 591 '#(11 13 17 19 23 29)) 592 lst)) 593 594 (pass-if-error "non-vector" 595 (let ((lst '())) 596 (vector-for-each (lambda (i x y z) 597 (set! lst (cons (+ (* i x) (- y z)) lst))) 598 '#(5 4 3 2 1) 599 '(2 3 5 7) 600 '#(11 13 17 19 23 29)) 601 lst)) 602 603 (pass-if-error "non-procedure" 604 (let ((lst '())) 605 (vector-for-each '#(not a procedure) 606 '#(5 4 3 2 1) 607 '#(2 3 5 7) 608 '#(11 13 17 19 23 29)) 609 lst))) 610 611;; 612;; vector-count 613;; 614 615(with-test-prefix "vector-count" 616 617 (pass-if-equal "1 vector" 618 3 619 (vector-count (lambda (i x) (even? (+ i x))) '#(2 3 5 7 11))) 620 621 (pass-if-equal "1 empty vector" 622 0 623 (vector-count values '#())) 624 625 (pass-if-equal "2 vectors, unequal lengths" 626 3 627 (vector-count (lambda (i x y) (< x (* i y))) 628 '#(8 2 7 8 9 1 0) 629 '#(7 6 4 3 1))) 630 631 (pass-if-equal "3 vectors, unequal lengths" 632 2 633 (vector-count (lambda (i x y z) (<= x (- y i) z)) 634 '#(3 6 3 0 2 4 1) 635 '#(8 7 4 4 9) 636 '#(7 6 8 3 1 7 9))) 637 638 (pass-if-error "non-vector" 639 (vector-count (lambda (i x y z) (<= x (- y i) z)) 640 '#(3 6 3 0 2 4 1) 641 '#(8 7 4 4 9) 642 '(7 6 8 3 1 7 9))) 643 644 (pass-if-error "non-procedure" 645 (vector-count '(1 2) 646 '#(3 6 3 0 2 4 1) 647 '#(8 7 4 4 9) 648 '#(7 6 8 3 1 7 9)))) 649 650;;; 651;;; Searching 652;;; 653 654;; 655;; vector-index 656;; 657 658(with-test-prefix "vector-index" 659 660 (pass-if-equal "1 vector" 661 2 662 (vector-index even? '#(3 1 4 1 6 9))) 663 664 (pass-if-equal "2 vectors, unequal lengths, success" 665 1 666 (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 667 668 (pass-if-equal "2 vectors, unequal lengths, failure" 669 #f 670 (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 671 672 (pass-if-error "non-procedure" 673 (vector-index 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 674 675 (pass-if-error "3 args, non-vector" 676 (vector-index = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) 677 678 (pass-if-error "4 args, non-vector" 679 (vector-index = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) 680 681 (pass-if-equal "3 vectors, unequal lengths, success" 682 1 683 (vector-index < 684 '#(3 1 4 1 5 9 2 5 6) 685 '#(2 6 1 7 2) 686 '#(2 7 1 8))) 687 688 (pass-if-equal "3 vectors, unequal lengths, failure" 689 #f 690 (vector-index < 691 '#(3 1 4 1 5 9 2 5 6) 692 '#(2 7 1 7 2) 693 '#(2 7 1 7))) 694 695 (pass-if-equal "empty vector" 696 #f 697 (vector-index < '#() '#(2 7 1 8 2)))) 698 699;; 700;; vector-index-right 701;; 702 703(with-test-prefix "vector-index-right" 704 705 (pass-if-equal "1 vector" 706 4 707 (vector-index-right even? '#(3 1 4 1 6 9))) 708 709 (pass-if-equal "2 vectors, unequal lengths, success" 710 3 711 (vector-index-right < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 712 713 (pass-if-equal "2 vectors, unequal lengths, failure" 714 #f 715 (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 716 717 (pass-if-error "non-procedure" 718 (vector-index-right 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 719 720 (pass-if-error "3 args, non-vector" 721 (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) 722 723 (pass-if-error "4 args, non-vector" 724 (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) 725 726 (pass-if-equal "3 vectors, unequal lengths, success" 727 3 728 (vector-index-right < 729 '#(3 1 4 1 5 9 2 5 6) 730 '#(2 6 1 7 2) 731 '#(2 7 1 8))) 732 733 (pass-if-equal "3 vectors, unequal lengths, failure" 734 #f 735 (vector-index-right < 736 '#(3 1 4 1 5 9 2 5 6) 737 '#(2 7 1 7 2) 738 '#(2 7 1 7))) 739 740 (pass-if-equal "empty vector" 741 #f 742 (vector-index-right < '#() '#(2 7 1 8 2)))) 743 744;; 745;; vector-skip 746;; 747 748(with-test-prefix "vector-skip" 749 750 (pass-if-equal "1 vector" 751 2 752 (vector-skip odd? '#(3 1 4 1 6 9))) 753 754 (pass-if-equal "2 vectors, unequal lengths, success" 755 1 756 (vector-skip >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 757 758 (pass-if-equal "2 vectors, unequal lengths, failure" 759 #f 760 (vector-skip (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 761 762 (pass-if-error "non-procedure" 763 (vector-skip 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 764 765 (pass-if-error "3 args, non-vector" 766 (vector-skip = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) 767 768 (pass-if-error "4 args, non-vector" 769 (vector-skip = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) 770 771 (pass-if-equal "3 vectors, unequal lengths, success" 772 1 773 (vector-skip (negate <) 774 '#(3 1 4 1 5 9 2 5 6) 775 '#(2 6 1 7 2) 776 '#(2 7 1 8))) 777 778 (pass-if-equal "3 vectors, unequal lengths, failure" 779 #f 780 (vector-skip (negate <) 781 '#(3 1 4 1 5 9 2 5 6) 782 '#(2 7 1 7 2) 783 '#(2 7 1 7))) 784 785 (pass-if-equal "empty vector" 786 #f 787 (vector-skip (negate <) '#() '#(2 7 1 8 2)))) 788 789;; 790;; vector-skip-right 791;; 792 793(with-test-prefix "vector-skip-right" 794 795 (pass-if-equal "1 vector" 796 4 797 (vector-skip-right odd? '#(3 1 4 1 6 9))) 798 799 (pass-if-equal "2 vectors, unequal lengths, success" 800 3 801 (vector-skip-right >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 802 803 (pass-if-equal "2 vectors, unequal lengths, failure" 804 #f 805 (vector-skip-right (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 806 807 (pass-if-error "non-procedure" 808 (vector-skip-right 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) 809 810 (pass-if-error "3 args, non-vector" 811 (vector-skip-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) 812 813 (pass-if-error "4 args, non-vector" 814 (vector-skip-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) 815 816 (pass-if-equal "3 vectors, unequal lengths, success" 817 3 818 (vector-skip-right (negate <) 819 '#(3 1 4 1 5 9 2 5 6) 820 '#(2 6 1 7 2) 821 '#(2 7 1 8))) 822 823 (pass-if-equal "3 vectors, unequal lengths, failure" 824 #f 825 (vector-skip-right (negate <) 826 '#(3 1 4 1 5 9 2 5 6) 827 '#(2 7 1 7 2) 828 '#(2 7 1 7))) 829 830 (pass-if-equal "empty vector" 831 #f 832 (vector-skip-right (negate <) '#() '#(2 7 1 8 2)))) 833 834;; 835;; vector-binary-search 836;; 837 838(with-test-prefix "vector-binary-search" 839 840 (define (char-cmp c1 c2) 841 (cond ((char<? c1 c2) -1) 842 ((char=? c1 c2) 0) 843 (else 1))) 844 845 (pass-if-equal "success" 846 6 847 (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) 848 #\g 849 char-cmp)) 850 851 (pass-if-equal "failure" 852 #f 853 (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g) 854 #\q 855 char-cmp)) 856 857 (pass-if-equal "singleton vector, success" 858 0 859 (vector-binary-search '#(#\a) 860 #\a 861 char-cmp)) 862 863 (pass-if-equal "empty vector" 864 #f 865 (vector-binary-search '#() 866 #\a 867 char-cmp)) 868 869 (pass-if-error "first element" 870 (vector-binary-search '(#\a #\b #\c) 871 #\a 872 char-cmp)) 873 874 (pass-if-equal "specify range, success" 875 3 876 (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) 877 #\d 878 char-cmp 879 2 6)) 880 881 (pass-if-equal "specify range, failure" 882 #f 883 (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) 884 #\g 885 char-cmp 886 2 6))) 887 888;; 889;; vector-any 890;; 891 892(with-test-prefix "vector-any" 893 894 (pass-if-equal "1 vector, success" 895 #t 896 (vector-any even? '#(3 1 4 1 5 9 2))) 897 898 (pass-if-equal "1 vector, failure" 899 #f 900 (vector-any even? '#(3 1 5 1 5 9 1))) 901 902 (pass-if-equal "1 vector, left-to-right" 903 #t 904 (vector-any even? '#(3 1 4 1 5 #f 2))) 905 906 (pass-if-equal "1 vector, left-to-right" 907 4 908 (vector-any (lambda (x) (and (even? x) x)) 909 '#(3 1 4 1 5 #f 2))) 910 911 (pass-if-equal "1 empty vector" 912 #f 913 (vector-any even? '#())) 914 915 (pass-if-equal "2 vectors, unequal lengths, success" 916 '(1 2) 917 (vector-any (lambda (x y) (and (< x y) (list x y))) 918 '#(3 1 4 1 5 #f) 919 '#(1 0 1 2 3))) 920 921 (pass-if-equal "2 vectors, unequal lengths, failure" 922 #f 923 (vector-any < '#(3 1 4 1 5 #f) '#(1 0 1 0 3))) 924 925 (pass-if-equal "3 vectors, unequal lengths, success" 926 '(1 2 3) 927 (vector-any (lambda (x y z) (and (< x y z) (list x y z))) 928 '#(3 1 4 1 3 #f) 929 '#(1 0 1 2 4) 930 '#(2 1 6 3 5))) 931 932 (pass-if-equal "3 vectors, unequal lengths, failure" 933 #f 934 (vector-any < 935 '#(3 1 4 1 5 #f) 936 '#(1 0 3 2) 937 '#(2 1 6 2 3)))) 938 939;; 940;; vector-every 941;; 942 943(with-test-prefix "vector-every" 944 945 (pass-if-equal "1 vector, failure" 946 #f 947 (vector-every odd? '#(3 1 4 1 5 9 2))) 948 949 (pass-if-equal "1 vector, success" 950 11 951 (vector-every (lambda (x) (and (odd? x) x)) 952 '#(3 5 7 1 5 9 11))) 953 954 (pass-if-equal "1 vector, left-to-right, failure" 955 #f 956 (vector-every odd? '#(3 1 4 1 5 #f 2))) 957 958 (pass-if-equal "1 empty vector" 959 #t 960 (vector-every even? '#())) 961 962 (pass-if-equal "2 vectors, unequal lengths, left-to-right, failure" 963 #f 964 (vector-every >= '#(3 1 4 1 5) '#(1 0 1 2 3 #f))) 965 966 (pass-if-equal "2 vectors, unequal lengths, left-to-right, success" 967 '(5 3) 968 (vector-every (lambda (x y) (and (>= x y) (list x y))) 969 '#(3 1 4 1 5) 970 '#(1 0 1 0 3 #f))) 971 972 (pass-if-equal "3 vectors, unequal lengths, left-to-right, failure" 973 #f 974 (vector-every >= 975 '#(3 1 4 1 5) 976 '#(1 0 1 2 3 #f) 977 '#(0 0 1 2))) 978 979 (pass-if-equal "3 vectors, unequal lengths, left-to-right, success" 980 '(8 5 4) 981 (vector-every (lambda (x y z) (and (>= x y z) (list x y z))) 982 '#(3 5 4 8 5) 983 '#(2 3 4 5 3 #f) 984 '#(1 2 3 4)))) 985 986;;; 987;;; Mutators 988;;; 989 990;; 991;; vector-set! 992;; 993 994(with-test-prefix "vector-set!" 995 996 (pass-if-equal "simple" 997 '#(0 a 2) 998 (let ((v (vector 0 1 2))) 999 (vector-set! v 1 'a) 1000 v)) 1001 1002 (pass-if-error "index beyond end" (vector-set! (vector 0 1 2) 3 'a)) 1003 (pass-if-error "negative index" (vector-set! (vector 0 1 2) -1 'a)) 1004 (pass-if-error "empty vector" (vector-set! (vector) 0 'a))) 1005 1006;; 1007;; vector-swap! 1008;; 1009 1010(with-test-prefix "vector-swap!" 1011 1012 (pass-if-equal "simple" 1013 '#(b a c) 1014 (let ((v (vector 'a 'b 'c))) 1015 (vector-swap! v 0 1) 1016 v)) 1017 1018 (pass-if-equal "same index" 1019 '#(a b c) 1020 (let ((v (vector 'a 'b 'c))) 1021 (vector-swap! v 1 1) 1022 v)) 1023 1024 (pass-if-error "index beyond end" (vector-swap! (vector 'a 'b 'c) 0 3)) 1025 (pass-if-error "negative index" (vector-swap! (vector 'a 'b 'c) -1 1)) 1026 (pass-if-error "empty vector" (vector-swap! (vector) 0 0))) 1027 1028;; 1029;; vector-fill! 1030;; 1031 1032(with-test-prefix "vector-fill!" 1033 1034 (pass-if-equal "2 args" 1035 '#(z z z z z) 1036 (let ((v (vector 'a 'b 'c 'd 'e))) 1037 (vector-fill! v 'z) 1038 v)) 1039 1040 (pass-if-equal "3 args" 1041 '#(a b z z z) 1042 (let ((v (vector 'a 'b 'c 'd 'e))) 1043 (vector-fill! v 'z 2) 1044 v)) 1045 1046 (pass-if-equal "4 args" 1047 '#(a z z d e) 1048 (let ((v (vector 'a 'b 'c 'd 'e))) 1049 (vector-fill! v 'z 1 3) 1050 v)) 1051 1052 (pass-if-equal "4 args, entire vector" 1053 '#(z z z z z) 1054 (let ((v (vector 'a 'b 'c 'd 'e))) 1055 (vector-fill! v 'z 0 5) 1056 v)) 1057 1058 (pass-if-equal "4 args, empty range" 1059 '#(a b c d e) 1060 (let ((v (vector 'a 'b 'c 'd 'e))) 1061 (vector-fill! v 'z 2 2) 1062 v)) 1063 1064 (pass-if-error "index beyond end" (vector-fill! (vector 'a 'b 'c) 'z 0 4)) 1065 (pass-if-error "invalid range" (vector-fill! (vector 'a 'b 'c) 'z 2 1)) 1066 (pass-if-error "negative index" (vector-fill! (vector 'a 'b 'c) 'z -1 1)) 1067 1068 ;; This is intentionally allowed in Guile, as an extension: 1069 ;;(pass-if-error "vector-fill! e3" (vector-fill! (vector) 'z 0 0)) 1070 ) 1071 1072;; 1073;; vector-reverse! 1074;; 1075 1076(with-test-prefix "vector-reverse!" 1077 1078 (pass-if-equal "1 arg" 1079 '#(e d c b a) 1080 (let ((v (vector 'a 'b 'c 'd 'e))) 1081 (vector-reverse! v) 1082 v)) 1083 1084 (pass-if-equal "2 args" 1085 '#(a b f e d c) 1086 (let ((v (vector 'a 'b 'c 'd 'e 'f))) 1087 (vector-reverse! v 2) 1088 v)) 1089 1090 (pass-if-equal "3 args" 1091 '#(a d c b e f) 1092 (let ((v (vector 'a 'b 'c 'd 'e 'f))) 1093 (vector-reverse! v 1 4) 1094 v)) 1095 1096 (pass-if-equal "3 args, empty range" 1097 '#(a b c d e f) 1098 (let ((v (vector 'a 'b 'c 'd 'e 'f))) 1099 (vector-reverse! v 3 3) 1100 v)) 1101 1102 (pass-if-equal "3 args, singleton range" 1103 '#(a b c d e f) 1104 (let ((v (vector 'a 'b 'c 'd 'e 'f))) 1105 (vector-reverse! v 3 4) 1106 v)) 1107 1108 (pass-if-equal "empty vector" 1109 '#() 1110 (let ((v (vector))) 1111 (vector-reverse! v) 1112 v)) 1113 1114 (pass-if-error "index beyond end" (vector-reverse! (vector 'a 'b) 0 3)) 1115 (pass-if-error "invalid range" (vector-reverse! (vector 'a 'b) 2 1)) 1116 (pass-if-error "negative index" (vector-reverse! (vector 'a 'b) -1 1)) 1117 1118 ;; This is intentionally allowed in Guile, as an extension: 1119 ;;(pass-if-error "vector-reverse! e3" (vector-reverse! (vector) 0 0)) 1120 ) 1121 1122;; 1123;; vector-copy! 1124;; 1125 1126(with-test-prefix "vector-copy!" 1127 1128 (pass-if-equal "3 args, 0 tstart" 1129 '#(1 2 3 d e) 1130 (let ((v (vector 'a 'b 'c 'd 'e))) 1131 (vector-copy! v 0 '#(1 2 3)) 1132 v)) 1133 1134 (pass-if-equal "3 args, 2 tstart" 1135 '#(a b 1 2 3) 1136 (let ((v (vector 'a 'b 'c 'd 'e))) 1137 (vector-copy! v 2 '#(1 2 3)) 1138 v)) 1139 1140 (pass-if-equal "4 args" 1141 '#(a b 2 3 e) 1142 (let ((v (vector 'a 'b 'c 'd 'e))) 1143 (vector-copy! v 2 '#(1 2 3) 1) 1144 v)) 1145 1146 (pass-if-equal "5 args" 1147 '#(a b 3 4 5) 1148 (let ((v (vector 'a 'b 'c 'd 'e))) 1149 (vector-copy! v 2 '#(1 2 3 4 5) 2 5) 1150 v)) 1151 1152 (pass-if-equal "5 args, empty range" 1153 '#(a b c d e) 1154 (let ((v (vector 'a 'b 'c 'd 'e))) 1155 (vector-copy! v 2 '#(1 2 3) 1 1) 1156 v)) 1157 1158 (pass-if-equal "overlapping source/target, moving right" 1159 '#(b c c d e) 1160 (let ((v (vector 'a 'b 'c 'd 'e))) 1161 (vector-copy! v 0 v 1 3) 1162 v)) 1163 1164 (pass-if-equal "overlapping source/target, moving left" 1165 '#(a b b c d) 1166 (let ((v (vector 'a 'b 'c 'd 'e))) 1167 (vector-copy! v 2 v 1 4) 1168 v)) 1169 1170 (pass-if-equal "overlapping source/target, not moving" 1171 '#(a b c d e) 1172 (let ((v (vector 'a 'b 'c 'd 'e))) 1173 (vector-copy! v 0 v 0) 1174 v)) 1175 1176 (pass-if-error "tstart beyond end" 1177 (vector-copy! (vector 1 2) 3 '#(1 2 3))) 1178 (pass-if-error "would overwrite target end" 1179 (vector-copy! (vector 1 2) 0 '#(1 2 3))) 1180 (pass-if-error "would overwrite target end" 1181 (vector-copy! (vector 1 2) 1 '#(1 2 3) 1))) 1182 1183;; 1184;; vector-reverse-copy! 1185;; 1186 1187(with-test-prefix "vector-reverse-copy!" 1188 1189 (pass-if-equal "3 args, 0 tstart" 1190 '#(3 2 1 d e) 1191 (let ((v (vector 'a 'b 'c 'd 'e))) 1192 (vector-reverse-copy! v 0 '#(1 2 3)) 1193 v)) 1194 1195 (pass-if-equal "3 args, 2 tstart" 1196 '#(a b 3 2 1) 1197 (let ((v (vector 'a 'b 'c 'd 'e))) 1198 (vector-reverse-copy! v 2 '#(1 2 3)) 1199 v)) 1200 1201 (pass-if-equal "4 args" 1202 '#(a b 3 2 e) 1203 (let ((v (vector 'a 'b 'c 'd 'e))) 1204 (vector-reverse-copy! v 2 '#(1 2 3) 1) 1205 v)) 1206 1207 (pass-if-equal "5 args" 1208 '#(a b 4 3 2) 1209 (let ((v (vector 'a 'b 'c 'd 'e))) 1210 (vector-reverse-copy! v 2 '#(1 2 3 4 5) 1 4) 1211 v)) 1212 1213 (pass-if-equal "5 args, empty range" 1214 '#(a b c d e) 1215 (let ((v (vector 'a 'b 'c 'd 'e))) 1216 (vector-reverse-copy! v 2 '#(1 2 3 4 5) 2 2) 1217 v)) 1218 1219 (pass-if-equal "3 args, overlapping source/target" 1220 '#(e d c b a) 1221 (let ((v (vector 'a 'b 'c 'd 'e))) 1222 (vector-reverse-copy! v 0 v) 1223 v)) 1224 1225 (pass-if-equal "5 args, overlapping source/target" 1226 '#(b a c d e) 1227 (let ((v (vector 'a 'b 'c 'd 'e))) 1228 (vector-reverse-copy! v 0 v 0 2) 1229 v)) 1230 1231 (pass-if-error "3 args, would overwrite target end" 1232 (vector-reverse-copy! (vector 'a 'b) 2 '#(a b))) 1233 (pass-if-error "3 args, negative tstart" 1234 (vector-reverse-copy! (vector 'a 'b) -1 '#(a b))) 1235 (pass-if-error "3 args, would overwrite target end" 1236 (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c))) 1237 (pass-if-error "5 args, send beyond end" 1238 (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 1 4)) 1239 (pass-if-error "5 args, negative sstart" 1240 (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) -1 2)) 1241 (pass-if-error "5 args, invalid source range" 1242 (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 2 1))) 1243 1244;;; 1245;;; Conversion 1246;;; 1247 1248;; 1249;; vector->list 1250;; 1251 1252(with-test-prefix "vector->list" 1253 1254 (pass-if-equal "1 arg" 1255 '(a b c) 1256 (vector->list '#(a b c))) 1257 1258 (pass-if-equal "2 args" 1259 '(b c) 1260 (vector->list '#(a b c) 1)) 1261 1262 (pass-if-equal "3 args" 1263 '(b c d) 1264 (vector->list '#(a b c d e) 1 4)) 1265 1266 (pass-if-equal "3 args, empty range" 1267 '() 1268 (vector->list '#(a b c d e) 1 1)) 1269 1270 (pass-if-equal "1 arg, empty vector" 1271 '() 1272 (vector->list '#())) 1273 1274 (pass-if-error "index beyond end" (vector->list '#(a b c) 1 6)) 1275 (pass-if-error "negative index" (vector->list '#(a b c) -1 1)) 1276 (pass-if-error "invalid range" (vector->list '#(a b c) 2 1))) 1277 1278;; 1279;; reverse-vector->list 1280;; 1281 1282(with-test-prefix "reverse-vector->list" 1283 1284 (pass-if-equal "1 arg" 1285 '(c b a) 1286 (reverse-vector->list '#(a b c))) 1287 1288 (pass-if-equal "2 args" 1289 '(c b) 1290 (reverse-vector->list '#(a b c) 1)) 1291 1292 (pass-if-equal "3 args" 1293 '(d c b) 1294 (reverse-vector->list '#(a b c d e) 1 4)) 1295 1296 (pass-if-equal "3 args, empty range" 1297 '() 1298 (reverse-vector->list '#(a b c d e) 1 1)) 1299 1300 (pass-if-equal "1 arg, empty vector" 1301 '() 1302 (reverse-vector->list '#())) 1303 1304 (pass-if-error "index beyond end" (reverse-vector->list '#(a b c) 1 6)) 1305 (pass-if-error "negative index" (reverse-vector->list '#(a b c) -1 1)) 1306 (pass-if-error "invalid range" (reverse-vector->list '#(a b c) 2 1))) 1307 1308;; 1309;; list->vector 1310;; 1311 1312(with-test-prefix "list->vector" 1313 1314 (pass-if-equal "1 arg" 1315 '#(a b c) 1316 (list->vector '(a b c))) 1317 1318 (pass-if-equal "1 empty list" 1319 '#() 1320 (list->vector '())) 1321 1322 (pass-if-equal "2 args" 1323 '#(2 3) 1324 (list->vector '(0 1 2 3) 2)) 1325 1326 (pass-if-equal "3 args" 1327 '#(0 1) 1328 (list->vector '(0 1 2 3) 0 2)) 1329 1330 (pass-if-equal "3 args, empty range" 1331 '#() 1332 (list->vector '(0 1 2 3) 2 2)) 1333 1334 (pass-if-error "index beyond end" (list->vector '(0 1 2 3) 0 5)) 1335 (pass-if-error "negative index" (list->vector '(0 1 2 3) -1 1)) 1336 (pass-if-error "invalid range" (list->vector '(0 1 2 3) 2 1))) 1337 1338;; 1339;; reverse-list->vector 1340;; 1341 1342(with-test-prefix "reverse-list->vector" 1343 1344 (pass-if-equal "1 arg" 1345 '#(c b a) 1346 (reverse-list->vector '(a b c))) 1347 1348 (pass-if-equal "1 empty list" 1349 '#() 1350 (reverse-list->vector '())) 1351 1352 (pass-if-equal "2 args" 1353 '#(3 2) 1354 (reverse-list->vector '(0 1 2 3) 2)) 1355 1356 (pass-if-equal "3 args" 1357 '#(1 0) 1358 (reverse-list->vector '(0 1 2 3) 0 2)) 1359 1360 (pass-if-equal "3 args, empty range" 1361 '#() 1362 (reverse-list->vector '(0 1 2 3) 2 2)) 1363 1364 (pass-if-error "index beyond end" 1365 (reverse-list->vector '(0 1 2 3) 0 5)) 1366 1367 (pass-if-error "negative index" 1368 (reverse-list->vector '(0 1 2 3) -1 1)) 1369 1370 (pass-if-error "invalid range" 1371 (reverse-list->vector '(0 1 2 3) 2 1))) 1372 1373;;; Local Variables: 1374;;; eval: (put 'pass-if-error 'scheme-indent-function 1) 1375;;; End: 1376