From fb9c34275389e23f32d80954ab4848fac48936d9 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 2 May 2004 18:12:42 +0000 Subject: [PATCH] 0.8.10.7: Fix obsolete instance problem from Bruno Haible "installing sbcl" sbcl-devel 2004-04-15 ... Nikodemus' fix is so much better than my hack; ... add the multiple inheritance test suggested by Bruno Haible; ... also really really fix the threads.impure.lisp :if-exists :supersede thing (though the test still fails for me on 2.6 with :sb-futex) --- BUGS | 21 +++------------------ NEWS | 4 +++- src/pcl/cache.lisp | 5 ++--- src/pcl/std-class.lisp | 9 ++++++++- tests/clos.impure.lisp | 26 ++++++++++++++++++++++++++ tests/threads.impure.lisp | 2 +- version.lisp-expr | 2 +- 7 files changed, 44 insertions(+), 25 deletions(-) diff --git a/BUGS b/BUGS index 325068d..e2c7ca7 100644 --- a/BUGS +++ b/BUGS @@ -1283,24 +1283,6 @@ WORKAROUND: collect `(array ,(sb-vm:saetp-specifier x))))) => NIL, T (when it should be T, T) -307: "Problem in obsolete instance protocol" - (reported by Bruno Haible as the fourth problem in sbcl-devel - "installing sbcl" 2004-04-15) - - (progn - (defclass foo92b (foo92a) ((s :initarg :s))) - (defclass foo92a () ()) - (let ((x (make-instance 'foo92b :s 5)) (update-counter 0)) - (defclass foo92b (foo92a) ((s) (s1) (s2))) ; still subclass of foo92a - (slot-value x 's) - (defmethod update-instance-for-redefined-class - ((object foo92b) added-slots discarded-slots plist &rest initargs) - (incf update-counter)) - (make-instances-obsolete 'foo92a) - (slot-value x 's) - update-counter)) - => 0 ; should be 1 - 308: "Characters without names" (reported by Bruno Haible sbcl-devel "character names are missing" 2004-04-19) @@ -1357,6 +1339,9 @@ WORKAROUND: ;;; as non-exponential notation, using the method described in the ;;; Steele and White paper. + See also CSR sbcl-devel with an implementation of Berger and + Dybvig's algorithm for printing and a fix for reading. + 311: "Tokeniser not thread-safe" (see also Robert Marlow sbcl-help "Multi threaded read chucking a spak" 2004-04-19) diff --git a/NEWS b/NEWS index b4941de..1ea3f0e 100644 --- a/NEWS +++ b/NEWS @@ -2401,11 +2401,13 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10: * fixed bug 313: source-transform for was erroneously applied to a call of a value of a variable with name . (reported by Antonio Menezes Leitao) + * fixed bug 307: The obsolete instance protocol ensures that + subclasses are properly obsoleted. (thanks to Nikodemus Siivola) * on X86 fixed bug 298, revealed by Paul F. Dietz' test suite: SBCL can remove dead unknown-values globs from the middle of the stack. * added a new restart to *BREAK-ON-SIGNALS* handling to make it easier to resume long computations after using *BREAK-ON-SIGNALS* - to diagnose and fix failures (thanks to Nikodemus Siivola) + to diagnose and fix failures. (thanks to Nikodemus Siivola) planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index ed83efd..007acfe 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -367,9 +367,8 @@ ;; INSTANCE's class. See also the comment above ;; FORCE-CACHE-FLUSHES. Paul Dietz has test cases for this. ((member t) - (let ((class (class-of instance))) - (force-cache-flushes class) - (class-wrapper class))) + (force-cache-flushes (class-of instance)) + (check-wrapper-validity instance)) (cons (ecase (car state) (:flush diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index b9c034e..d03f94e 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -1291,7 +1291,14 @@ (with-pcl-lock (update-lisp-class-layout class nwrapper) (setf (slot-value class 'wrapper) nwrapper) - (invalidate-wrapper owrapper :flush nwrapper)))))) + ;; Use :OBSOLETE instead of :FLUSH if any superclass has + ;; been obsoleted. + (if (find-if (lambda (x) + (and (consp x) (eq :obsolete (car x)))) + (layout-inherits owrapper) + :key #'layout-invalid) + (invalidate-wrapper owrapper :obsolete nwrapper) + (invalidate-wrapper owrapper :flush nwrapper))))))) (defun flush-cache-trap (owrapper nwrapper instance) (declare (ignore owrapper)) diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index 7a5a0fb..25358d4 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -740,5 +740,31 @@ ((size :initarg :size :initform 2 :allocation :class))) (assert (= (slot-value i 'size) 1))) +;;; reported by Bruno Haible sbcl-devel 2004-04-15 +(defclass superclass-born-to-be-obsoleted () (a)) +(defclass subclass-born-to-be-obsoleted (superclass-born-to-be-obsoleted) ()) +(defparameter *born-to-be-obsoleted* + (make-instance 'subclass-born-to-be-obsoleted)) +(defparameter *born-to-be-obsoleted-obsoleted* nil) +(defmethod update-instance-for-redefined-class + ((o subclass-born-to-be-obsoleted) a d pl &key) + (setf *born-to-be-obsoleted-obsoleted* t)) +(make-instances-obsolete 'superclass-born-to-be-obsoleted) +(slot-boundp *born-to-be-obsoleted* 'a) +(assert *born-to-be-obsoleted-obsoleted*) + +;;; additional test suggested by Bruno Haible sbcl-devel 2004-04-21 +(defclass super-super-obsoleted () (a)) +(defclass super-obsoleted-1 (super-super-obsoleted) ()) +(defclass super-obsoleted-2 (super-super-obsoleted) ()) +(defclass obsoleted (super-obsoleted-1 super-obsoleted-2) ()) +(defparameter *obsoleted* (make-instance 'obsoleted)) +(defparameter *obsoleted-counter* 0) +(defmethod update-instance-for-redefined-class ((o obsoleted) a d pl &key) + (incf *obsoleted-counter*)) +(make-instances-obsolete 'super-super-obsoleted) +(slot-boundp *obsoleted* 'a) +(assert (= *obsoleted-counter* 1)) + ;;;; success (sb-ext:quit :unix-status 104) diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index 4b59604..c0feefe 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -18,7 +18,7 @@ ;;; For one of the interupt-thread tests, we want a foreign function ;;; that does not make syscalls -(with-open-file (o "threads-foreign.c" :direction :output) +(with-open-file (o "threads-foreign.c" :direction :output :if-exists :supersede) (format o "void loop_forever() { while(1) ; }~%")) (sb-ext:run-program "cc" diff --git a/version.lisp-expr b/version.lisp-expr index ff112f9..e8e648a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.10.6" +"0.8.10.7" -- 1.7.10.4