1.0.23.56: special variables cause special cases in CLOS cleverness

 * As we cannot reliably ensure nothing calls SET or (SETF
   SYMBOL-VALUE) on the special variable, we need to disable
   optimizations perutation vector optimizations for them.

 * For the same reason we cannot implicitly declare types for even
   local specials in DEFMETHODs.

 * Delete bug 276: the issue it refers to was fixed back when we
   stopped inserting declarations for special variables.

diff --git a/BUGS b/BUGS
index d7ecde8..15269e7 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -841,14 +841,6 @@ WORKAROUND:
 
   (fixed in 0.8.2.51, but a test case would be good)
 
-276:
-  b. The same as in a., but using MULTIPLE-VALUE-SETQ instead of SETQ.
-  c. (defvar *faa*)
-     (defmethod faa ((*faa* double-float))
-           (set '*faa* (when (< *faa* 0) (- *faa*)))
-           (1+ *faa*))
-     (faa 1d0) => type error
-
 279: type propagation error -- correctly inferred type goes astray?
   In sbcl-0.8.3 and sbcl-0.8.1.47, the warning
        The binding of ABS-FOO is a (VALUES (INTEGER 0 0)

diff --git a/NEWS b/NEWS
index 0030620..131a63c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -38,6 +38,10 @@
   * bug fix: return values of READ-SEQUENCE did not take :START into
     account on file streams, regressions since 1.0.12.22. (reported by
     Daniel Herring, patch by Paul Huong)
+  * bug fix: using SET or (SETF SYMBOL-VALUE) to change the value of a
+    method specializer used to confuse permuation vector optimization.
+  * bug fix: system inserted bogus implicit type declarations for local
+    special variables in DEFMETHOD bodies.
 
 changes in sbcl-1.0.23 relative to 1.0.22:
   * enhancement: when disassembling method functions, disassembly

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index bedfc51..12467fa 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -590,6 +590,12 @@ bootstrapping.
   (setf (gdefinition 'make-method-lambda)
         (symbol-function 'real-make-method-lambda)))
 
+(defun declared-specials (declarations)
+  (loop for (declare . specifiers) in declarations
+        append (loop for specifier in specifiers
+                     when (eq 'special (car specifier))
+                     append (cdr specifier))))
+
 (defun make-method-lambda-internal (proto-gf proto-method method-lambda env)
   (declare (ignore proto-gf proto-method))
   (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda))
@@ -641,9 +647,12 @@ bootstrapping.
                   ;; KLUDGE: when I tried moving these to
                   ;; ADD-METHOD-DECLARATIONS, things broke.  No idea
                   ;; why.  -- CSR, 2004-06-16
-                  ,@(mapcar #'parameter-specializer-declaration-in-defmethod
-                            parameters
-                            specializers)))
+                  ,@(let ((specials (declared-specials declarations)))
+                      (mapcar (lambda (par spec)
+                                (parameter-specializer-declaration-in-defmethod
+                                 par spec specials env))
+                              parameters
+                              specializers))))
                (method-lambda
                 ;; Remove the documentation string and insert the
                 ;; appropriate class declarations. The documentation
@@ -799,8 +808,12 @@ bootstrapping.
         (symbol-function 'real-unparse-specializer-using-class)))
 
 ;;; a helper function for creating Python-friendly type declarations
-;;; in DEFMETHOD forms
-(defun parameter-specializer-declaration-in-defmethod (parameter specializer)
+;;; in DEFMETHOD forms.
+;;;
+;;; We're too lazy to cons up a new environment for this, so we just pass in
+;;; the list of locally declared specials in addition to the old environment.
+(defun parameter-specializer-declaration-in-defmethod
+    (parameter specializer specials env)
   (cond ((and (consp specializer)
               (eq (car specializer) 'eql))
          ;; KLUDGE: ANSI, in its wisdom, says that
@@ -853,16 +866,10 @@ bootstrapping.
          '(ignorable))
         ((typep specializer 'eql-specializer)
          `(type (eql ,(eql-specializer-object specializer)) ,parameter))
-        ((var-globally-special-p parameter)
-         ;; KLUDGE: Don't declare types for global special variables
-         ;; -- our rebinding magic for SETQ cases don't work right
-         ;; there.
-         ;;
-         ;; FIXME: It would be better to detect the SETQ earlier and
-         ;; skip declarations for specials only when needed, not
-         ;; always.
-         ;;
-         ;; --NS 2004-10-14
+        ((or (var-special-p parameter env) (member parameter specials))
+         ;; Don't declare types for special variables -- our rebinding magic
+         ;; for SETQ cases don't work right there as SET, (SETF SYMBOL-VALUE),
+         ;; etc. make things undecidable.
          '(ignorable))
         (t
          ;; Otherwise, we can usually make Python very happy.

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index 02700ec..606acba 100644 (file)
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -146,7 +146,7 @@
                     (slot-boundp 'boundp)))
             (var (extract-the var-form))
             (slot-name (constant-form-value slot-name-form env)))
-        (when (symbolp var)
+        (when (and (symbolp var) (not (var-special-p var env)))
           (let* ((rebound? (caddr (var-declaration '%variable-rebinding var env)))
                  (parameter-or-nil (car (memq (or rebound? var)
                                               required-parameters))))

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 34d38bd..877073c 100644 (file)
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1647,5 +1647,32 @@
   (defgeneric foo-slot (x y z))
   (defclass foo ()
     ((slot :accessor foo-slot-value))))
+
+;;; SET and (SETF SYMBOL-VALUE) used to confuse permuation vector
+;;; optimizations
+(defclass fih ()
+  ((x :initform :fih)))
+(defclass fah ()
+  ((x :initform :fah)))
+(declaim (special *fih*))
+(defmethod fihfah ((*fih* fih))
+  (set '*fih* (make-instance 'fah))
+  (list (slot-value *fih* 'x)
+        (eval '(slot-value *fih* 'x))))
+(defmethod fihfah ((fah fah))
+  (declare (special fah))
+  (set 'fah (make-instance 'fih))
+  (list (slot-value fah 'x)
+        (eval '(slot-value fah 'x))))
+(with-test (:name :set-of-a-method-specializer)
+  (assert (equal '(:fah :fah) (fihfah (make-instance 'fih))))
+  (assert (equal '(:fih :fih) (fihfah (make-instance 'fah)))))
+
+(defmethod no-implicit-declarations-for-local-specials ((faax double-float))
+  (declare (special faax))
+  (set 'faax (when (< faax 0) (- faax)))
+  faax)
+(with-test (:name :no-implicit-declarations-for-local-specials)
+  (assert (not (no-implicit-declarations-for-local-specials 1.0d0))))
 \f
 ;;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index c806284..e456d3f 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.23.55"
+"1.0.23.56"