diff --git a/pcl/cache.lisp b/pcl/cache.lisp index aa9c6a4c5f9b4ed13c44457112173c7d388d2e99..5d8efb1c6ad55e4459c992b47bcb71e5626f7f79 100644 --- a/pcl/cache.lisp +++ b/pcl/cache.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.34 2003/05/31 09:23:23 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.35 2005/06/20 13:03:21 rtoy Rel $") ;;; ;;; The basics of the PCL wrapper cache mechanism. @@ -411,16 +411,17 @@ ;; previous call to REGISTER-LAYOUT for a superclass of ;; INSTANCE's class. See also the comment above ;; FORCE-CACHE-FLUSHES. Paul Dietz has test cases for this. + ;; Note that FORCE-CACHE-FLUSHES may change LAYOUT-INVALID, + ;; so we have to recurse. ((eq state :invalid) - (let ((class (class-of instance))) - (force-cache-flushes class) - (class-wrapper class))) + (force-cache-flushes (class-of instance)) + (check-wrapper-validity instance)) + ((eq (car state) :flush) + (flush-cache-trap owrapper (second state) instance)) + ((eq (car state) :obsolete) + (obsolete-instance-trap owrapper (second state) instance)) (t - (ecase (first state) - (:flush - (flush-cache-trap owrapper (second state) instance)) - (:obsolete - (obsolete-instance-trap owrapper (second state) instance))))))) + (internal-error "Unknown wrapper state"))))) (declaim (inline check-obsolete-instance)) (defun check-obsolete-instance (instance) diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index 2a9797904d662a104302c90bacbca595cda2437e..11e58bde526a85e49d0fde89612a07fc40ebc9f6 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -26,7 +26,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.78 2005/05/31 18:10:05 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.79 2005/06/20 13:03:21 rtoy Exp $") (in-package :pcl) @@ -1341,7 +1341,14 @@ (with-pcl-lock (update-lisp-class-layout class nwrapper) (setf (slot-value class 'wrapper) nwrapper) - (invalidate-wrapper owrapper :flush nwrapper)))))) + (flet ((obsolete-super-p () + (some (lambda (layout) + (eq (car-safe (kernel:layout-invalid layout)) + :obsolete)) + (kernel:layout-inherits owrapper)))) + (invalidate-wrapper owrapper + (if (obsolete-super-p) :obsolete :flush) + nwrapper))))))) (defun flush-cache-trap (owrapper nwrapper instance) (declare (ignore owrapper))