0.8.10.52:

	Fix bug #321 (define-method-combination :arguments lambda lists)
	... add FIXME note that there are $n+2$ PARSE-LAMBDA-LISToid
		functions lying around

diff --git a/BUGS b/BUGS
index 3dc7a9c..b8f261c 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1362,22 +1362,6 @@ WORKAROUND:
     #(1 2 ((SB-IMPL::|,|) + 2 2) 4)
   which probably isn't intentional.
 
-321: "DEFINE-METHOD-COMBINATION lambda list parsing"
-  reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP
-  test suite.
-    (define-method-combination w-args ()
-      ((method-list *))
-      (:arguments arg1 arg2 &aux (extra :extra))
-     `(progn ,@(mapcar (lambda (method) `(call-method ,method)) method-list)))
-  gives a (caught) compile-time error, which can be exposed by
-    (defgeneric mc-test-w-args (p1 p2 s)
-      (:method-combination w-args)
-      (:method ((p1 number) (p2 t) s)
-        (vector-push-extend (list 'number p1 p2) s))
-      (:method ((p1 string) (p2 t) s)
-        (vector-push-extend (list 'string p1 p2) s))
-      (:method ((p1 t) (p2 t) s) (vector-push-extend (list t p1 p2) s)))
-
 323: "REPLACE, BIT-BASH and large strings"
   The transform for REPLACE on simple-base-strings uses BIT-BASH, which
   at present has an upper limit in size.  Consequently, in sbcl-0.8.10

diff --git a/NEWS b/NEWS
index dcd278d..e8f809e 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2458,6 +2458,9 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
   * fixed bug: lambda lists may contain symbols whose names start with
     & but are not lambda-list-keywords; their occurrence triggers a
     STYLE-WARNING.
+  * fixed bug 321: define-method-combination argument lambda lists do
+    not cause invalid code to be generated when &optional or &aux
+    variables have default values.  (reported by Bruno Haible)
   * optimization: rearranged the expansion of various defining macros
     so that each expands into only one top-level form in a
     :LOAD-TOPLEVEL context; this appears to decrease fasl sizes by

diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp
index 6163057..13781e5 100644 (file)
--- a/src/pcl/defcombin.lisp
+++ b/src/pcl/defcombin.lisp
@@ -409,12 +409,21 @@
 ;;;
 ;;; At compute-effective-method time, the symbols in the :arguments
 ;;; option are bound to the symbols in the intercept lambda list.
+;;;
+;;; FIXME: in here we have not one but two mini-copies of a weird
+;;; hybrid of PARSE-LAMBDA-LIST and PARSE-DEFMACRO-LAMBDA-LIST.
 (defun deal-with-args-option (wrapped-body args-lambda-list)
   (let ((intercept-rebindings
         (let (rebindings)
           (dolist (arg args-lambda-list (nreverse rebindings))
             (unless (member arg lambda-list-keywords)
-              (push `(,arg ',arg) rebindings)))))
+              (typecase arg
+                (symbol (push `(,arg ',arg) rebindings))
+                (cons
+                 (unless (symbolp (car arg))
+                   (error "invalid lambda-list specifier: ~S." arg))
+                 (push `(,(car arg) ',(car arg)) rebindings))
+                (t (error "invalid lambda-list-specifier: ~S." arg)))))))
        (nreq 0)
        (nopt 0)
        (whole nil))

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index ccdfeca..9c179fc 100644 (file)
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -792,5 +792,24 @@
   (assert (typep err 'error))
   (assert (not (typep err 'sb-int:bug))))
 
+;;; BUG 321: errors in parsing DEFINE-METHOD-COMBINATION arguments
+;;; lambda lists.
+
+(define-method-combination w-args ()
+  ((method-list *))
+  (:arguments arg1 arg2 &aux (extra :extra))
+  `(progn ,@(mapcar (lambda (method) `(call-method ,method)) method-list)))
+(defgeneric mc-test-w-args (p1 p2 s)
+  (:method-combination w-args)
+  (:method ((p1 number) (p2 t) s)
+    (vector-push-extend (list 'number p1 p2) s))
+  (:method ((p1 string) (p2 t) s)
+    (vector-push-extend (list 'string p1 p2) s))
+  (:method ((p1 t) (p2 t) s) (vector-push-extend (list t p1 p2) s)))
+(let ((v (make-array 0 :adjustable t :fill-pointer t)))
+  (assert (= (mc-test-w-args 1 2 v) 1))
+  (assert (equal (aref v 0) '(number 1 2)))
+  (assert (equal (aref v 1) '(t 1 2))))
+
 ;;;; success
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 2e90834..6eb5db9 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.10.51"
+"0.8.10.52"