From: Christophe R. <cr...@us...> - 2003-10-15 16:28:21
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1:/tmp/cvs-serv26184/tests Modified Files: clos.impure.lisp Log Message: 0.8.4.23: Fix for bug 191c (and some of PFD's tests) ... do proper keyword argument checking in the effective method ... not the cleanest fix in the world (note especially the use of PROGN as an optimization inhibitor) ... I'm not telling you how long it took me to find the NCONC -> APPEND bug in fngen.lisp Index: clos.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v retrieving revision 1.45 retrieving revision 1.46 diff -u -d -r1.45 -r1.46 --- clos.impure.lisp 14 Oct 2003 07:31:05 -0000 1.45 +++ clos.impure.lisp 15 Oct 2003 16:28:15 -0000 1.46 @@ -700,5 +700,25 @@ (declare (notinline slot-value)) a)) +;;; from CLHS 7.6.5.1 +(defclass character-class () ((char :initarg :char))) +(defclass picture-class () ((glyph :initarg :glyph))) +(defclass character-picture-class (character-class picture-class) ()) + +(defmethod width ((c character-class) &key font) font) +(defmethod width ((p picture-class) &key pixel-size) pixel-size) + +(assert (raises-error? + (width (make-instance 'character-class :char #\Q) + :font 'baskerville :pixel-size 10) + program-error)) +(assert (raises-error? + (width (make-instance 'picture-class :glyph #\Q) + :font 'baskerville :pixel-size 10) + program-error)) +(assert (eq (width (make-instance 'character-picture-class :char #\Q) + :font 'baskerville :pixel-size 10) + 'baskerville)) + ;;;; success (sb-ext:quit :unix-status 104) |