Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2635/src/pcl
Modified Files:
boot.lisp vector.lisp
Log Message:
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!
Index: boot.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -d -r1.81 -r1.82
--- boot.lisp 29 Jun 2004 08:51:01 -0000 1.81
+++ boot.lisp 1 Jul 2004 11:41:22 -0000 1.82
@@ -1252,6 +1252,14 @@
(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)
Index: vector.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/vector.lisp,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -d -r1.31 -r1.32
--- vector.lisp 29 Jun 2004 08:51:01 -0000 1.31
+++ vector.lisp 1 Jul 2004 11:41:22 -0000 1.32
@@ -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))
|