Just Launched: You can now import projects and releases from Google Code onto SourceForge
We are excited to release new functionality to enable a 1-click import from Google Code onto the Allura platform on SourceForge. You can import tickets, wikis, source, releases, and more with a few simple steps. Read More
Update of /cvsroot/sbcl/sbcl/tests
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv2238/tests
22.214.171.124: faster ARRAY-DIMENSION for non-vectors
Previously each ARRAY-DIMENSION call for a non-vector resulted in
checking (1) if the array was a displaced array (2) if the array it
was displaced to was still big enough for it.
This sucks pretty badly, because we use ARRAY-DIMENSION in bounds
checking -- especially given how rare it is to have an array
displaced to an adjustable array.
Add a new slot, ARRAY-DISPLACED-FROM, to array-headers, and store a
list of weak backpointers to arrays displaced to the array in
question there. SET-ARRAY-HEADER (as part of ADJUST-ARRAY) now
checks this list, and signals an error if any of the displaced-from
arrays is larger than the new size.
This also allows us to open code ARRAY-DIMENSION as long as the
array rank is known.
RCS file: /cvsroot/sbcl/sbcl/tests/array.pure.lisp,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -d -r1.35 -r1.36
--- array.pure.lisp 23 Apr 2009 12:26:58 -0000 1.35
+++ array.pure.lisp 6 May 2009 16:28:04 -0000 1.36
@@ -163,16 +163,17 @@
;;; BUG 315: "no bounds check for access to displaced array"
;;; reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP
;;; test suite.
-(multiple-value-bind (val err)
- (locally (declare (optimize (safety 3) (speed 0)))
- (let* ((x (make-array 10 :fill-pointer 4 :element-type 'character
- :initial-element #\space :adjustable t))
- (y (make-array 10 :fill-pointer 4 :element-type 'character
- :displaced-to x)))
- (adjust-array x '(5))
- (char y 5))))
- (assert (and (not val) (typep err 'sb-kernel:displaced-to-array-too-small-error))))
+(locally (declare (optimize (safety 3) (speed 0)))
+ (let* ((x (make-array 10 :fill-pointer 4 :element-type 'character
+ :initial-element #\space :adjustable t))
+ (y (make-array 10 :fill-pointer 4 :element-type 'character
+ :displaced-to x)))
+ (adjust-array x '(5))
+ (error (e)
+ (assert (typep e 'sb-int:simple-reference-error))
+ (assert (equal '((:ansi-cl function adjust-array))
+ (sb-int:reference-condition-references e)))))))
;;; MISC.527: bit-vector bitwise operations used LENGTH to get a size
;;; of a vector