0.8.12.15:

	Fix for (declare ignore) treatment in methods when there is use
	of SETQ in the body
	... wow, no-one noticed before me?  Cool!

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index e89443f..3e6d8b3 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -1252,6 +1252,14 @@ bootstrapping.
                    (setq next-method-p-p t)
                    form)
                   ((eq (car form) 'setq)
+                   ;; FIXME: this is possibly a little strong as
+                   ;; conditions go.  Ideally we would want to detect
+                   ;; which, if any, of the method parameters are
+                   ;; being set, and communicate that information to
+                   ;; e.g. SPLIT-DECLARATIONS.  However, the brute
+                   ;; force method doesn't really cost much; a little
+                   ;; loss of discrimination over IGNORED variables
+                   ;; should be all.  -- CSR, 2004-07-01
                    (setq setq-p t)
                    form)
                   ((and (eq (car form) 'function)

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index 995fa6f..7403d3a 100644 (file)
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -958,7 +958,7 @@
     simple-bit-vector simple-string simple-vector single-float standard-char
     stream string symbol t unsigned-byte vector))
 
-(defun split-declarations (body args calls-next-method-p)
+(defun split-declarations (body args maybe-reads-params-p)
   (let ((inner-decls nil)
        (outer-decls nil)
        decl)
@@ -1011,7 +1011,7 @@
                               ;; involved, to prevent compiler
                               ;; warnings about ignored args being
                               ;; read.
-                              (unless (and calls-next-method-p
+                              (unless (and maybe-reads-params-p
                                            (eq (car dname) 'ignore))
                                 (push var outers))
                               (push var inners)))
@@ -1083,7 +1083,8 @@
     (initargs body req-args lmf-params restp)
   (multiple-value-bind (outer-decls inner-decls body-sans-decls)
       (split-declarations
-       body req-args (getf (cdr lmf-params) :call-next-method-p))
+       body req-args (or (getf (cdr lmf-params) :call-next-method-p)
+                        (getf (cdr lmf-params) :setq-p)))
     (let* ((rest-arg (when restp '.rest-arg.))
           (args+rest-arg (if restp
                              (append req-args (list rest-arg))

diff --git a/tests/clos.impure-cload.lisp b/tests/clos.impure-cload.lisp
index e9e09b5..46f83e6 100644 (file)
--- a/tests/clos.impure-cload.lisp
+++ b/tests/clos.impure-cload.lisp
@@ -105,5 +105,19 @@
 (assert (eq 'orig-initform
            (slot-value (make-instance 'shared-to-local-initform-sub) 'redefined)))
 \f
+(defgeneric no-ignored-warnings (x y))
+(handler-case
+    (eval '(defmethod no-ignored-warnings ((x t) (y t))
+           (declare (ignore x y)) nil))
+  (style-warning (c) (error c)))
+(handler-case
+    (eval '(defmethod no-ignored-warnings ((x number) (y t))
+           (declare (ignore x y)) (setq *print-level* nil)))
+  (style-warning (c) (error c)))
+(handler-case
+    (eval '(defmethod no-ignored-warnings ((x fixnum) (y t))
+           (declare (ignore x)) (setq y 'foo)))
+  (style-warning (c) (error c)))
+\f
 ;;; success
-(sb-ext:quit :unix-status 104)
\ No newline at end of file
+(sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 6eec739..ad18e79 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".)
-"0.8.12.14"
+"0.8.12.15"