From 72f8804f1a2ea98cfccdd7972b299cc309c55279 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 24 May 2004 14:28:20 +0000 Subject: [PATCH] 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 --- BUGS | 16 ---------------- NEWS | 3 +++ src/pcl/defcombin.lisp | 11 ++++++++++- tests/clos.impure.lisp | 19 +++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 33 insertions(+), 18 deletions(-) diff --git a/BUGS b/BUGS index 3dc7a9c..b8f261c 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4