From a14326d4e328c778cd292884099eee7d2c1b8d0f Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 1 Jul 2004 11:41:22 +0000 Subject: [PATCH] 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! --- src/pcl/boot.lisp | 8 ++++++++ src/pcl/vector.lisp | 7 ++++--- tests/clos.impure-cload.lisp | 16 +++++++++++++++- version.lisp-expr | 2 +- 4 files changed, 28 insertions(+), 5 deletions(-) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index e89443f..3e6d8b3 100644 --- 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 --- 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 --- 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))) +(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))) + ;;; 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 --- 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" -- 1.7.10.4