From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 1 Dec 2008 15:44:41 +0000 (+0000)
Subject: 1.0.23.4: fix error signalling from (SETF FILL-POINTER)
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5758a6ab4c2d046b68b5409d13ed6b8d6199ba7c;p=sbcl.git

1.0.23.4: fix error signalling from (SETF FILL-POINTER)

 * Thanks to Stas Boukarev.
---

diff --git a/NEWS b/NEWS
index 443a38b..1e2de05 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@
     SB-CLTL2. (reported by Larry D'Anna)
   * bug fix: STRING-TO-OCTETS did not handle :START properly when
     using UTF-8 as external format. (thanks to Luis Oliveira)
+  * bug fix: errors from invalid fill-pointer values to (SETF FILL-POINTER)
+    are signalled correctly. (thanks to Stas Boukarev)
 
 changes in sbcl-1.0.23 relative to 1.0.22:
   * enhancement: when disassembling method functions, disassembly
diff --git a/src/code/array.lisp b/src/code/array.lisp
index 34de463..7c2790e 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -776,7 +776,7 @@ of specialized arrays is supported."
                   :datum arg
                   :expected-type (list 'integer 0 max)
                   :format-control "The new fill pointer, ~S, is larger than the length of the vector (~S.)"
-                  arg max)))
+                  :format-arguments (list arg max))))
         (t
          (error 'simple-type-error
                 :datum vector
diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp
index 7760a6c..31975cc 100644
--- a/tests/array.pure.lisp
+++ b/tests/array.pure.lisp
@@ -226,3 +226,13 @@
   (let ((ary (make-array '(2 2))))
     ;; SBCL used to give multidimensional arrays a bogus fill-pointer
     (assert (not (array-has-fill-pointer-p (adjust-array ary '(2 2)))))))
+
+(with-test (:name %set-fill-pointer/error)
+  (let ((v (make-array 3 :fill-pointer 0))) 
+    (handler-case
+        (progn
+          (setf (fill-pointer v) 12)
+          (error "WTF"))
+      (error (e)
+        (assert (eql 12 (type-error-datum e)))
+        (assert (equal '(integer 0 3) (type-error-expected-type e)))))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 82d37e0..fbf898b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.23.3"
+"1.0.23.4"