[Sbcl-commits] CVS: sbcl/tests clos.impure.lisp,1.45,1.46

[Christophe R. <cr...@us...>]

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)