1.0.7.22: (SETF SYMBOL-PLIST) type checking

 * Disallow non-lists as the new value.

diff --git a/NEWS b/NEWS
index 47475d0..d453f74 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,8 @@ changes in sbcl-1.0.8 relative to sbcl-1.0.7:
     variables now works on x86-64.  (reported by Christopher Laux)
   * bug fix: modifications to packages (INTERN, EXPORT, etc) are now
     thread safe.
+  * bug fix: (SETF SYMBOL-PLIST) no longer allows assigning a non-list
+    as the property-list of a symbol.
 
 changes in sbcl-1.0.7 relative to sbcl-1.0.6:
   * MOP improvement: support for user-defined subclasses of

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 46b3aa9..efee375 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1509,7 +1509,7 @@
   :destroyed-constant-args (nth-constant-args 1))
 (defknown %set-symbol-value (symbol t) t (unsafe))
 (defknown (setf symbol-function) (function symbol) function (unsafe))
-(defknown %set-symbol-plist (symbol t) t (unsafe))
+(defknown %set-symbol-plist (symbol list) list (unsafe))
 (defknown (setf fdocumentation) ((or string null) t symbol)
   (or string null)
   ())

diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index f4c515d..bf81d29 100644 (file)
--- a/src/compiler/generic/objdef.lisp
+++ b/src/compiler/generic/objdef.lisp
@@ -324,6 +324,7 @@
   (plist :ref-trans symbol-plist
          :set-trans %set-symbol-plist
          :cas-trans %compare-and-swap-symbol-plist
+         :type list
          :init :null)
   (name :ref-trans symbol-name :init :arg)
   (package :ref-trans symbol-package

diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp
index ce4ec85..50c3441 100644 (file)
--- a/tests/list.pure.lisp
+++ b/tests/list.pure.lisp
@@ -136,3 +136,13 @@
                         (assoc x '(nil (a . b) nil (nil . c) (c . d))
                          :test #'eq)))))
   (assert (equal (funcall f 'nil) '(nil . c))))
+
+;;; enforce lists in symbol-plist
+(let ((s (gensym))
+      (l (list 1 3 4)))
+  (assert (not (symbol-plist s)))
+  (assert (eq l (setf (symbol-plist s) l)))
+  (multiple-value-bind (res err)
+      (ignore-errors (setf (symbol-plist s) (car l)))
+    (assert (not res))
+    (assert (typep err 'type-error))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 20b6688..93f0421 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.7.21"
+"1.0.7.22"