324 |
|
|
325 |
;;;; Strings |
;;;; Strings |
326 |
|
|
327 |
|
(loop for element-type in '(character base-char) |
328 |
|
for forms = `( |
329 |
(def-adjust-array-test adjust-array.string.1 |
(def-adjust-array-test adjust-array.string.1 |
330 |
(5 :element-type 'character :initial-contents "abcde") |
(5 :element-type 'character :initial-contents "abcde") |
331 |
(4 :element-type 'character) |
(4 :element-type 'character) |
480 |
a2) |
a2) |
481 |
#.(make-array nil :initial-element #\x :element-type 'character)) |
#.(make-array nil :initial-element #\x :element-type 'character)) |
482 |
|
|
483 |
|
(def-adjust-array-test adjust-array.string.adjustable.1 |
484 |
|
(5 :initial-contents "abcde" :adjustable t :element-type 'character) |
485 |
|
(4 :element-type 'character) |
486 |
|
"abcd") |
487 |
|
|
488 |
|
(def-adjust-array-test adjust-array.string.adjustable.2 |
489 |
|
(5 :initial-contents "abcde" :adjustable t :element-type 'character) |
490 |
|
(8 :initial-element #\x :element-type 'character) |
491 |
|
"abcdexxx") |
492 |
|
|
493 |
|
(def-adjust-array-test adjust-array.string.adjustable.3 |
494 |
|
(5 :initial-contents "abcde" :adjustable t :element-type 'character) |
495 |
|
(4 :initial-contents "wxyz" :element-type 'character) |
496 |
|
"wxyz") |
497 |
|
|
498 |
|
(def-adjust-array-test adjust-array.string.adjustable.4 |
499 |
|
(5 :initial-contents "abcde" :adjustable t :element-type 'character) |
500 |
|
(8 :initial-contents "87654321" :element-type 'character) |
501 |
|
"87654321") |
502 |
|
|
503 |
|
(def-adjust-array-fp-test adjust-array.string.adjustable.5 |
504 |
|
(5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character) |
505 |
|
(4 :element-type 'character :initial-element #\Space) |
506 |
|
(assert (eq (aref a2 3) #\d)) |
507 |
|
3 "abc") |
508 |
|
|
509 |
|
(def-adjust-array-fp-test adjust-array.string.adjustable.6 |
510 |
|
(5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character) |
511 |
|
(4 :fill-pointer nil :element-type 'character :initial-element #\?) |
512 |
|
(assert (eq (aref a2 3) #\d)) |
513 |
|
3 "abc") |
514 |
|
|
515 |
|
(def-adjust-array-fp-test adjust-array.string.adjustable.7 |
516 |
|
(5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character) |
517 |
|
(4 :fill-pointer t :element-type 'character :initial-element #\!) |
518 |
|
nil |
519 |
|
4 "abcd") |
520 |
|
|
521 |
|
(def-adjust-array-fp-test adjust-array.string.adjustable.8 |
522 |
|
(5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character) |
523 |
|
(4 :fill-pointer 2 :element-type 'character :initial-element #\X) |
524 |
|
(assert (equal (list (aref a2 2) (aref a2 3)) '(#\c #\d))) |
525 |
|
2 "ab") |
526 |
|
|
527 |
|
(def-adjust-array-fp-test adjust-array.string.adjustable.9 |
528 |
|
(5 :initial-contents "abcde" :fill-pointer 3 :adjustable t :element-type 'character) |
529 |
|
(8 :fill-pointer 5 :initial-element #\x :element-type 'character) |
530 |
|
(assert (equal (list (aref a2 5) (aref a2 6) (aref a2 7)) '(#\x #\x #\x))) |
531 |
|
5 "abcde") |
532 |
|
|
533 |
|
(deftest adjust-array.string.adjustable.10 |
534 |
|
(let* ((a1 (make-array 5 :initial-contents "abcde" |
535 |
|
:adjustable t :element-type 'character)) |
536 |
|
(a2 (adjust-array a1 4 :displaced-to nil :element-type 'character))) |
537 |
|
(assert (eq a1 a2)) |
538 |
|
(assert (not (array-displacement a2))) |
539 |
|
a2) |
540 |
|
"abcd") |
541 |
|
|
542 |
|
(deftest adjust-array.string.adjustable.11 |
543 |
|
(let* ((a0 (make-array 7 :initial-contents "xabcdey" :element-type 'character)) |
544 |
|
(a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1 |
545 |
|
:adjustable t :element-type 'character)) |
546 |
|
(a2 (adjust-array a1 4 :element-type 'character))) |
547 |
|
(assert (eq a1 a2)) |
548 |
|
(assert (not (array-displacement a2))) |
549 |
|
a2) |
550 |
|
"abcd") |
551 |
|
|
552 |
|
(deftest adjust-array.string.adjustable.12 |
553 |
|
(let* ((a0 (make-array 7 :initial-contents "xabcdey" :element-type 'character)) |
554 |
|
(a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1 |
555 |
|
:adjustable t :element-type 'character)) |
556 |
|
(a2 (adjust-array a1 4 :displaced-to a0 :element-type 'character))) |
557 |
|
(assert (eq a1 a2)) |
558 |
|
a2) |
559 |
|
"xabc") |
560 |
|
|
561 |
|
(deftest adjust-array.string.adjustable.13 |
562 |
|
(let* ((a0 (make-array 7 :initial-contents "xabcdey" :element-type 'character)) |
563 |
|
(a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1 |
564 |
|
:adjustable t :element-type 'character)) |
565 |
|
(a2 (make-array 4 :displaced-to a1 :displaced-index-offset 1 |
566 |
|
:element-type 'character))) |
567 |
|
(assert (eq a1 (adjust-array a1 5 :displaced-to a0 |
568 |
|
:displaced-index-offset 2 |
569 |
|
:element-type 'character))) |
570 |
|
a2) |
571 |
|
"cdey") |
572 |
|
) |
573 |
|
for forms2 = (subst element-type 'character forms) |
574 |
|
for forms3 = (mapcar #'(lambda (form) |
575 |
|
(destructuring-bind (dt name . body) form |
576 |
|
`(,dt ,(if (eql element-type 'character) name |
577 |
|
(intern (replace (copy-seq (symbol-name name)) |
578 |
|
"BASEST" |
579 |
|
:start1 13 :end1 19) |
580 |
|
(symbol-package name))) |
581 |
|
,@ body))) |
582 |
|
forms2) |
583 |
|
do (eval `(progn ,@forms3))) |
584 |
|
|
585 |
;; 2-d arrays |
;; 2-d arrays |
586 |
|
|
587 |
(def-adjust-array-test adjust-array.string.21 |
(def-adjust-array-test adjust-array.string.21 |
600 |
"78912000" "00000000" "00000000") |
"78912000" "00000000" "00000000") |
601 |
:element-type 'character)) |
:element-type 'character)) |
602 |
|
|
|
;;; FIXME: Add adjustable string tests |
|
|
|
|
|
;;; FIXME: Add bit vector tests |
|
|
|
|
603 |
(def-adjust-array-test adjust-array.bit-vector.1 |
(def-adjust-array-test adjust-array.bit-vector.1 |
604 |
(5 :element-type 'bit :initial-contents #*01100) |
(5 :element-type 'bit :initial-contents #*01100) |
605 |
(4 :element-type 'bit) |
(4 :element-type 'bit) |
771 |
#*11111000 #*00000000 #*00000000) |
#*11111000 #*00000000 #*00000000) |
772 |
:element-type 'bit)) |
:element-type 'bit)) |
773 |
|
|
774 |
|
;;; Adjustable bit vector tests |
775 |
|
|
776 |
|
(def-adjust-array-test adjust-array.bit-vector.adjustable.1 |
777 |
|
(5 :initial-contents '(1 0 1 1 0) :adjustable t :element-type 'bit) |
778 |
|
(4 :element-type 'bit) |
779 |
|
#*1011) |
780 |
|
|
781 |
|
(def-adjust-array-test adjust-array.bit-vector.adjustable.2 |
782 |
|
(5 :initial-contents '(1 0 1 0 1) :adjustable t :element-type 'bit) |
783 |
|
(8 :initial-element '1 :element-type 'bit) |
784 |
|
#*10101111) |
785 |
|
|
786 |
|
(def-adjust-array-test adjust-array.bit-vector.adjustable.3 |
787 |
|
(5 :initial-contents '(0 1 0 1 0) :adjustable t :element-type 'bit) |
788 |
|
(4 :initial-contents '(1 1 1 0) :element-type 'bit) |
789 |
|
#*1110) |
790 |
|
|
791 |
|
(def-adjust-array-test adjust-array.bit-vector.adjustable.4 |
792 |
|
(5 :initial-contents '(1 0 0 1 0) :adjustable t :element-type 'bit) |
793 |
|
(8 :initial-contents '(0 1 0 1 1 0 1 0) :element-type 'bit) |
794 |
|
#*01011010) |
795 |
|
|
796 |
|
(def-adjust-array-fp-test adjust-array.bit-vectoradjustable.5 |
797 |
|
(5 :initial-contents '(1 1 1 0 0) :fill-pointer 3 :adjustable t :element-type 'bit) |
798 |
|
(4 :element-type 'bit :initial-element 0) |
799 |
|
(assert (eq (aref a2 3) 0)) |
800 |
|
3 #*111) |
801 |
|
|
802 |
|
(def-adjust-array-fp-test adjust-array.bit-vector.adjustable.6 |
803 |
|
(5 :initial-contents '(0 0 0 1 1) :fill-pointer 3 :adjustable t :element-type 'bit) |
804 |
|
(4 :fill-pointer nil :element-type 'bit :initial-element 1) |
805 |
|
(assert (eq (aref a2 3) 1)) |
806 |
|
3 #*000) |
807 |
|
|
808 |
|
(def-adjust-array-fp-test adjust-array.bit-vector.adjustable.7 |
809 |
|
(5 :initial-contents '(1 1 0 1 1) :fill-pointer 3 :adjustable t :element-type 'bit) |
810 |
|
(4 :fill-pointer t :element-type 'bit :initial-element 1) |
811 |
|
nil |
812 |
|
4 #*1101) |
813 |
|
|
814 |
|
(def-adjust-array-fp-test adjust-array.bit-vector.adjustable.8 |
815 |
|
(5 :initial-contents '(0 1 1 1 0) :fill-pointer 3 :adjustable t :element-type 'bit) |
816 |
|
(4 :fill-pointer 2 :element-type 'bit :initial-element 0) |
817 |
|
(assert (equal (list (aref a2 2) (aref a2 3)) '(1 1))) |
818 |
|
2 #*01) |
819 |
|
|
820 |
|
(def-adjust-array-fp-test adjust-array.bit-vector.adjustable.9 |
821 |
|
(5 :initial-contents '(1 0 0 0 1) :fill-pointer 3 :adjustable t :element-type 'bit) |
822 |
|
(8 :fill-pointer 5 :initial-element 1 :element-type 'bit) |
823 |
|
(assert (equal (list (aref a2 5) (aref a2 6) (aref a2 7)) '(1 1 1))) |
824 |
|
5 #*10001) |
825 |
|
|
826 |
|
(deftest adjust-array.bit-vector.adjustable.10 |
827 |
|
(let* ((a1 (make-array 5 :initial-contents '(0 1 1 0 1) |
828 |
|
:adjustable t :element-type 'bit)) |
829 |
|
(a2 (adjust-array a1 4 :displaced-to nil :element-type 'bit))) |
830 |
|
(assert (eq a1 a2)) |
831 |
|
(assert (not (array-displacement a2))) |
832 |
|
a2) |
833 |
|
#*0110) |
834 |
|
|
835 |
|
(deftest adjust-array.bit-vector.adjustable.11 |
836 |
|
(let* ((a0 (make-array 7 :initial-contents '(0 1 0 1 1 1 0) |
837 |
|
:element-type 'bit)) |
838 |
|
(a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1 |
839 |
|
:adjustable t :element-type 'bit)) |
840 |
|
(a2 (adjust-array a1 4 :element-type 'bit))) |
841 |
|
(assert (eq a1 a2)) |
842 |
|
(assert (not (array-displacement a2))) |
843 |
|
a2) |
844 |
|
#*1011) |
845 |
|
|
846 |
|
(deftest adjust-array.bit-vector.adjustable.12 |
847 |
|
(let* ((a0 (make-array 7 :initial-contents '(0 0 1 1 1 1 1) |
848 |
|
:element-type 'bit)) |
849 |
|
(a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1 |
850 |
|
:adjustable t :element-type 'bit)) |
851 |
|
(a2 (adjust-array a1 4 :displaced-to a0 :element-type 'bit))) |
852 |
|
(assert (eq a1 a2)) |
853 |
|
a2) |
854 |
|
#*0011) |
855 |
|
|
856 |
|
(deftest adjust-array.bit-vector.adjustable.13 |
857 |
|
(let* ((a0 (make-array 7 :initial-contents '(1 0 0 0 0 0 1) :element-type 'bit)) |
858 |
|
(a1 (make-array 5 :displaced-to a0 :displaced-index-offset 1 |
859 |
|
:adjustable t :element-type 'bit)) |
860 |
|
(a2 (make-array 4 :displaced-to a1 :displaced-index-offset 1 |
861 |
|
:element-type 'bit))) |
862 |
|
(assert (eq a1 (adjust-array a1 5 :displaced-to a0 |
863 |
|
:displaced-index-offset 2 |
864 |
|
:element-type 'bit))) |
865 |
|
a2) |
866 |
|
#*0001) |
867 |
|
|
868 |
;;; FIXME. specialized integer array tests |
;;; FIXME. specialized integer array tests |
869 |
|
|
870 |
;;; FIXNME float array tests |
;;; FIXNME float array tests |