Re: Lambda-list congruency bug?

[harrisr@turing.cs.rpi.edu (Richard Harris)]

This bug happens because the test 
   "update-instance-for-redefined-class/make-instances-obsolete(2)"
defines a before method for update-instance-for-redefined-class
which has an arglist with &key, but without any keyword arguments,
and without &allow-other-keys.  The method method-pretty-arglist
(defined on standard-method) treats such methods as though they
do not have &key at all, so check-lambda-list-congruency reports
a conflict with the existing method for update-instance-for-redefined-class
(defined on object), which has a &rest arg.

Solution    (assumes that &allow-other-keys is never used without &key)
1. Change the lines of method-pretty-arglist (in methods.lisp)
  from:
	    ((eq arg '&key)              (setq state 'key))
	    ((eq arg '&allow-other-keys) (setq allow-other-keys 't))
  to:
	    ((eq arg '&key)              (setq state 'key)
             (or (eq allow-other-keys 't)(setq allow-other-keys ':allow-other-keys)))
	    ((eq arg '&allow-other-keys) (setq allow-other-keys 't))

2. Change the method generic-function-pretty-arglist (in methods.lisp) 
  to:
(defmethod generic-function-pretty-arglist
           ((generic-function standard-generic-function))
  (let ((methods (generic-function-methods generic-function))
	(arglist ()))
    (when methods
      (multiple-value-bind (required optional rest key allow-other-keys)
	  (method-pretty-arglist (car methods))
	(let ((key-p allow-other-keys))                    ; ** changed
	  (setq allow-other-keys (eq allow-other-keys 't)) ; ** changed
	  (dolist (m (cdr methods))
	    (multiple-value-bind (method-key-keywords method-allow-other-keys method-key)
		(function-keywords m)
	      ;; we've modified function-keywords to return what we want as
	      ;;  the third value, no other change here.
	      (declare (ignore method-key-keywords))
	      (setq key (union key method-key))
	      (setq allow-other-keys (or allow-other-keys
					 method-allow-other-keys))))
	  (when allow-other-keys
	    (setq arglist '(&allow-other-keys)))
	  (when key-p			                   ; ** changed
	    (setq arglist (nconc (list '&key) key arglist)))
	  (when rest
	    (setq arglist (nconc (list '&rest rest) arglist)))
	  (when optional
	    (setq arglist (nconc (list '&optional) optional arglist)))
	  (nconc required arglist))))))