X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Farray.lisp;h=d300256604807ea764b00b2abd17180b97a900dc;hb=791e9d15abba835457b308121668a0ce75386a03;hp=0a76afaae608399d669df13df3f69b1994513039;hpb=b3f188843330c56bd4d17a3c930e73f573b1c71f;p=sbcl.git

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 0a76afa..d300256 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -538,7 +538,25 @@
 	 (error "Axis number ~W is too big; ~S only has ~D dimension~:P."
 		axis-number array (%array-rank array)))
 	(t
-	 (%array-dimension array axis-number))))
+	 ;; ANSI sayeth (ADJUST-ARRAY dictionary entry): 
+	 ;; 
+	 ;;   "If A is displaced to B, the consequences are
+	 ;;   unspecified if B is adjusted in such a way that it no
+	 ;;   longer has enough elements to satisfy A.
+	 ;;
+	 ;; In situations where this matters we should be doing a
+	 ;; bounds-check, which in turn uses ARRAY-DIMENSION -- so
+	 ;; this seems like a good place to signal an error.
+	 (multiple-value-bind (target offset) (array-displacement array)
+	   (when (and target 
+		      (> (array-total-size array)
+			 (- (array-total-size target) offset)))
+	       (error 'displaced-to-array-too-small-error
+		      :format-control "~@<The displaced-to array is too small. ~S ~
+                                      elements after offset required, ~S available.~:@>"
+		      :format-arguments (list (array-total-size array) 
+					      (- (array-total-size target) offset))))
+	   (%array-dimension array axis-number)))))
 
 (defun array-dimensions (array)
   #!+sb-doc