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)
|