[Sbcl-commits] CVS: sbcl/tests clos.impure.lisp,1.84,1.85

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

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv23147/tests

Modified Files:
	clos.impure.lisp 
Log Message:
0.9.15.17:
	OK then.  Fix %INSTANCE-TYPEP deftransform
	... if we're testing for a structure-classoid, then any object 
		with an invalid layout is neccessarily not typep that 
		class.
	... if we're testing for something with a fixed depthoid (i.e. 
		something which is always at a given position in the
		layout-inherits), then if we get an object with an 
		invalid layout we mustn't throw an error before trying
		to update the object.


Index: clos.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -d -r1.84 -r1.85
--- clos.impure.lisp	8 Aug 2006 14:24:27 -0000	1.84
+++ clos.impure.lisp	8 Aug 2006 20:14:22 -0000	1.85
@@ -1369,4 +1369,18 @@
 (assert (equal '(result) (test-mc27prime 3)))
 (assert (raises-error? (test-mc27 t))) ; still no-applicable-method
 
+;;; more invalid wrappers.  This time for a long-standing bug in the
+;;; compiler's expansion for TYPEP on various class-like things, with
+;;; user-visible consequences.
+(defclass obsolete-again () ())
+(defvar *obsolete-again* (make-instance 'obsolete-again))
+(defvar *obsolete-again-hash* (sxhash *obsolete-again*))
+(make-instances-obsolete (find-class 'obsolete-again))
+(assert (not (streamp *obsolete-again*)))
+(make-instances-obsolete (find-class 'obsolete-again))
+(assert (= (sxhash *obsolete-again*) *obsolete-again-hash*))
+(compile (defun is-a-structure-object-p (x) (typep x 'structure-object)))
+(make-instances-obsolete (find-class 'obsolete-again))
+(assert (not (is-a-structure-object-p *obsolete-again*)))
+
 ;;;; success