X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Farray.pure.lisp;h=6663f062301d368df6662ad2c2cc1f4a33c5397c;hb=40bf78b47ea89b15698adb9c550efa4cbacafeb7;hp=8a653519bb40d0c0505252691db292f9e320729c;hpb=d75b4eb603f1e9e366997c8e378fe0ae0d79b5d9;p=sbcl.git diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index 8a65351..6663f06 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -62,3 +62,49 @@ (aref x 12)))))) (error "error not thrown in COMPILED-DECLARED-AREF ~S" form)))))) +;;; On the SPARC, until sbcl-0.7.7.20, there was a bug in array +;;; references for small vector elements (spotted by Raymond Toy); the +;;; bug persisted on the PPC until sbcl-0.7.8.20. +(let (vector) + (loop for i below 64 + for list = (make-list 64 :initial-element 1) + do (setf (nth i list) 0) + do (setf vector (make-array 64 :element-type 'bit + :initial-contents list)) + do (assert (= (funcall + (compile nil + `(lambda (rmdr) + (declare (type (simple-array bit (*)) rmdr) + (optimize (speed 3) (safety 0))) + (aref rmdr ,i))) + vector) + 0)))) + +;;; Following refactoring of sequence functions to detect bad type +;;; specifiers, REVERSE was left broken on vectors with fill pointers. +(let ((a (make-array 10 + :fill-pointer 5 + :element-type 'character + :initial-contents "abcdefghij"))) + (assert (string= (reverse a) "edcba"))) + +;;; ARRAY-IN-BOUNDS-P should work when given non-INDEXes as its +;;; subscripts (and return NIL, of course) +(let ((a (make-array 10 :fill-pointer 5))) + (assert (not (array-in-bounds-p a -1))) + (assert (array-in-bounds-p a 3)) + (assert (array-in-bounds-p a 7)) + (assert (not (array-in-bounds-p a 11))) + (assert (not (array-in-bounds-p a (1+ most-positive-fixnum))))) + +;;; arrays of bits should work: +(let ((a (make-array '(10 10) :element-type 'bit :adjustable t))) + (setf (bit a 0 0) 1) + (assert (= (bit a 0 0) 1))) +(let ((a (make-array '(10 10) :element-type 'bit))) + (setf (sbit a 0 0) 1) + (assert (= (sbit a 0 0) 1))) + +(let ((x (copy-seq #*0011)) + (y (copy-seq #*0101))) + (assert (equalp (bit-and x y nil) #*0001)))