X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fseq.lisp;h=977e8a20340316e78e46689ab0c4a36d744d3f5c;hb=6c129930bd75f25a66aa0cbf0e5bc8091401d5ce;hp=7a20475cf6840bb639304aa0788cf17c9c8d92df;hpb=c25e4572f5505236faf126f38a74f32a80bf1e8c;p=sbcl.git

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 7a20475..977e8a2 100644
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -106,6 +106,16 @@
 			      ;; This seems silly, is there something better?
 			      '(integer (0) (0))))))
 
+(defun signal-end-too-large-error (sequence end)
+  (let* ((length (length sequence))
+	 (max-end (and (not (minusp length) length))))
+    (error 'end-too-large-error
+	   :datum end
+	   :expected-type (if max-index
+			      `(integer 0 ,max-end)
+			      ;; This seems silly, is there something better?
+			      '(integer (0) 0)))))
+
 (defun make-sequence-of-type (type length)
   #!+sb-doc "Return a sequence of the given TYPE and LENGTH."
   (declare (fixnum length))
@@ -207,21 +217,25 @@
 
 ;;;; SUBSEQ
 ;;;;
-;;;; The support routines for SUBSEQ are used by compiler transforms, so we
-;;;; worry about dealing with END being supplied or defaulting to NIL
-;;;; at this level.
+;;;; The support routines for SUBSEQ are used by compiler transforms,
+;;;; so we worry about dealing with END being supplied or defaulting
+;;;; to NIL at this level.
 
 (defun vector-subseq* (sequence start &optional end)
   (declare (type vector sequence))
   (declare (type fixnum start))
   (declare (type (or null fixnum) end))
-  (when (null end) (setf end (length sequence)))
+  (if (null end)
+      (setf end (length sequence))
+      (unless (<= end (length sequence))
+	(signal-index-too-large-error sequence end)))
   (do ((old-index start (1+ old-index))
        (new-index 0 (1+ new-index))
        (copy (make-sequence-like sequence (- end start))))
       ((= old-index end) copy)
     (declare (fixnum old-index new-index))
-    (setf (aref copy new-index) (aref sequence old-index))))
+    (setf (aref copy new-index)
+	  (aref sequence old-index))))
 
 (defun list-subseq* (sequence start &optional end)
   (declare (type list sequence))
@@ -240,10 +254,10 @@
 	      (declare (fixnum index)))
 	    ()))))
 
-;;; SUBSEQ cannot default end to the length of sequence since it is not
-;;; an error to supply nil for its value. We must test for end being nil
-;;; in the body of the function, and this is actually done in the support
-;;; routines for other reasons (see above).
+;;; SUBSEQ cannot default END to the length of sequence since it is
+;;; not an error to supply NIL for its value. We must test for END
+;;; being NIL in the body of the function, and this is actually done
+;;; in the support routines for other reasons. (See above.)
 (defun subseq (sequence start &optional end)
   #!+sb-doc
   "Return a copy of a subsequence of SEQUENCE starting with element number