[Sbcl-commits] CVS: sbcl/tests clos.impure.lisp,1.22,1.23 mop.impure.lisp,1.5,1.6

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

Update of /cvsroot/sbcl/sbcl/tests
In directory usw-pr-cvs1:/tmp/cvs-serv28688/tests

Modified Files:
	clos.impure.lisp mop.impure.lisp 
Log Message:
0.7.9.48:
	Fix COMPUTE-SLOTS :AROUND to do predictable things on
		STANDARD-CLASS
	... put a new slot (ALLOCATION-CLASS) into slotds, to be
		initialized to the relevant class if the allocation of
		the slot is :CLASS
	... use SLOT-ALLOCATION-CLASS where SLOT-ALLOCATION was used in
		the case of a :CLASS allocation
	... divide the COMPUTE-SLOTS :AROUND method into two, and leave
		the FUNCALLABLE-INSTANCE one alone


Index: clos.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- clos.impure.lisp	12 Nov 2002 15:33:41 -0000	1.22
+++ clos.impure.lisp	14 Nov 2002 11:31:53 -0000	1.23
@@ -428,6 +428,13 @@
   (assert (null result))
   (assert (typep error 'error)))
 
+;;; Classes with :ALLOCATION :CLASS slots should be subclassable (and
+;;; weren't for a while in sbcl-0.7.9.xx)
+(defclass superclass-with-slot ()
+  ((a :allocation :class)))
+(defclass subclass-for-class-allocation (superclass-with-slot) ())
+(make-instance 'subclass-for-class-allocation)
+
 ;;;; success
 
 (sb-ext:quit :unix-status 104)

Index: mop.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/mop.impure.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- mop.impure.lisp	4 Nov 2002 14:59:37 -0000	1.5
+++ mop.impure.lisp	14 Nov 2002 11:31:53 -0000	1.6
@@ -87,5 +87,13 @@
 (make-instance 'finalization-test-2)
 (assert (= (get-count) 3))
 
+;;; Bits of FUNCALLABLE-STANDARD-CLASS are easy to break; make sure
+;;; that it is at least possible to define classes with that as a
+;;; metaclass.
+(defclass gf-class (standard-generic-function) ()
+  (:metaclass sb-pcl::funcallable-standard-class))
+(defgeneric g (a b c)
+  (:generic-function-class gf-class))
+
 ;;;; success
 (sb-ext:quit :unix-status 104)