From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 23 May 2009 08:27:21 +0000 (+0000)
Subject: 1.0.28.70: regression in ABOUT-TO-MODIFY-SYMBOL-VALUE from 1.0.28.30
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=45ec97e8200790c0b60e1a567f7eaf0e99e75399;p=sbcl.git

1.0.28.70: regression in ABOUT-TO-MODIFY-SYMBOL-VALUE from 1.0.28.30

 * Patch and test-case by Stas Boukarev.
---

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 9891317..272e0eb 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -805,8 +805,8 @@
             (unless (sb!kernel::%%typep new-value type nil)
               (let ((spec (type-specifier type)))
                 (error 'simple-type-error
-                       :format-control "Cannot ~@? to ~S (not of type ~S.)"
-                       :format-arguments (list action (describe-action) new-value spec)
+                       :format-control "~@<Cannot ~@? to ~S, not of type ~S.~:@>"
+                       :format-arguments (list (describe-action) symbol new-value spec)
                        :datum new-value
                        :expected-type spec))))))))
   (values))
diff --git a/tests/symbol.impure.lisp b/tests/symbol.impure.lisp
new file mode 100644
index 0000000..e10c8c7
--- /dev/null
+++ b/tests/symbol.impure.lisp
@@ -0,0 +1,27 @@
+;;;; miscellaneous impure tests of SYMBOL-related stuff
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(in-package "CL-USER")
+
+(declaim (type (simple-array fixnum (*)) *foo*))
+(with-test (:name :defvar-type-error)
+  (assert (eq :ok
+              (handler-case
+                  (eval `(defvar *foo* (make-array 10 :element-type '(unsigned-byte 60))))
+                (type-error (e)
+                  (when (and (typep e 'type-error)
+                             (equal '(simple-array fixnum (*))
+                                    (type-error-expected-type e)))
+                    ;; Check that it prints without an error.
+                    (let ((string (princ-to-string e)))
+                      :ok)))))))
diff --git a/version.lisp-expr b/version.lisp-expr
index ecaf8b4..6d5b3ad 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.28.69"
+"1.0.28.70"