From: Christophe R. <cr...@us...> - 2002-11-19 16:00:24
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1:/tmp/cvs-serv14488/tests Modified Files: clos.impure.lisp Log Message: 0.7.9.57: DEFINE-METHOD-COMBINATION now works with the :ARGUMENTS option (more or less as per Gerd Moellmann cmucl-imp 2002-10-19) ... extra slot, extra logic; ... test from CLHS DEFINE-METHOD-COMBINATION page. Index: clos.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- clos.impure.lisp 14 Nov 2002 19:03:19 -0000 1.24 +++ clos.impure.lisp 19 Nov 2002 16:00:21 -0000 1.25 @@ -444,6 +444,40 @@ (call-next-method))) (assert (= (call-next-method-lexical-args 3) 3)) +;;; DEFINE-METHOD-COMBINATION with arguments was hopelessly broken +;;; until 0.7.9.5x +(defvar *d-m-c-args-test* nil) +(define-method-combination progn-with-lock () + ((methods ())) + (:arguments object) + `(unwind-protect + (progn (lock (object-lock ,object)) + ,@(mapcar #'(lambda (method) + `(call-method ,method)) + methods)) + (unlock (object-lock ,object)))) +(defun object-lock (obj) + (push "object-lock" *d-m-c-args-test*) + obj) +(defun unlock (obj) + (push "unlock" *d-m-c-args-test*) + obj) +(defun lock (obj) + (push "lock" *d-m-c-args-test*) + obj) +(defgeneric d-m-c-args-test (x) + (:method-combination progn-with-lock)) +(defmethod d-m-c-args-test ((x symbol)) + (push "primary" *d-m-c-args-test*)) +(defmethod d-m-c-args-test ((x number)) + (error "foo")) +(assert (equal (d-m-c-args-test t) '("primary" "lock" "object-lock"))) +(assert (equal *d-m-c-args-test* + '("unlock" "object-lock" "primary" "lock" "object-lock"))) +(setf *d-m-c-args-test* nil) +(ignore-errors (d-m-c-args-test 1)) +(assert (equal *d-m-c-args-test* + '("unlock" "object-lock" "lock" "object-lock"))) + ;;;; success - (sb-ext:quit :unix-status 104) |