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 (file)
--- 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 (file)
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 (file)
--- 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"