From 223ac55abed63769d0a3d5831b499d0ee9ee6462 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 29 Oct 2002 12:48:20 +0000 Subject: [PATCH] 0.7.9.12: Fix for BUG 140 (not opening bug 176 this time) from Gerd Moellmann, on cmucl-imp 86fzuwdkmy.fsf@gerd.free-bsd.org and private communication; entomotomy reference: redefined-classes-and-subtypep ... slightly kludgy logic in FORCE-CACHE-FLUSHES ... break me if you can BUGS frobbage, too; delete several old bugs that are probably fixed now. --- BUGS | 107 +-------------------------------------- src/pcl/braid.lisp | 2 +- src/pcl/cache.lisp | 127 +++++++++++++++-------------------------------- src/pcl/slots-boot.lisp | 26 +++++++--- src/pcl/slots.lisp | 40 +++++---------- src/pcl/std-class.lisp | 17 ++++--- tests/clos.impure.lisp | 15 ++++++ tests/type.impure.lisp | 4 +- version.lisp-expr | 2 +- 9 files changed, 102 insertions(+), 238 deletions(-) diff --git a/BUGS b/BUGS index d6d3cd7..fb9a754 100644 --- a/BUGS +++ b/BUGS @@ -356,9 +356,6 @@ WORKAROUND: crashes SBCL. In general tracing anything which is used in the implementation of TRACE is likely to have the same problem. -72: - (DECLAIM (OPTIMIZE ..)) doesn't work properly inside LOCALLY forms. - 75: As reported by Martin Atzmueller on sbcl-devel 26 Dec 2000, ANSI says that WITH-OUTPUT-TO-STRING should have a keyword @@ -499,18 +496,6 @@ WORKAROUND: the first time around, until regression tests are written I'm not comfortable merging the patches in the CVS version of SBCL. -104: - (DESCRIBE 'SB-ALIEN:DEF-ALIEN-TYPE) reports the macro argument list - incorrectly: - DEF-ALIEN-TYPE is - an external symbol - in #. - Macro-function: # - Macro arguments: (#:whole-470 #:environment-471) - On Sat, May 26, 2001 09:45:57 AM CDT it was compiled from: - /usr/stuff/sbcl/src/code/host-alieneval.lisp - Created: Monday, March 12, 2001 07:47:43 AM CST - 108: (TIME (ROOM T)) reports more than 200 Mbytes consed even for a clean, just-started SBCL system. And it seems to be right: @@ -584,26 +569,6 @@ WORKAROUND: is attached to FOO in 120a above, and used to optimize code which calls FOO. -122: - There was some sort of screwup in handling of - (IF (NOT (IGNORE-ERRORS ..))). E.g. - (defun foo1i () - (if (not (ignore-errors - (make-pathname :host "foo" - :directory "!bla" - :name "bar"))) - (print "ok") - (error "notunlessnot"))) - The (NOT (IGNORE-ERRORS ..)) form evaluates to T, so this should be - printing "ok", but instead it's going to the ERROR. This problem - seems to've been introduced by MNA's HANDLER-CASE patch (sbcl-devel - 2001-07-17) and as a workaround (put in sbcl-0.pre7.14.flaky4.12) - I reverted back to the old weird HANDLER-CASE code. However, I - think the problem looks like a compiler bug in handling RETURN-FROM, - so I left the MNA-patched code in HANDLER-CASE (suppressed with - #+NIL) and I'd like to go back to see whether this really is - a compiler bug before I delete this BUGS entry. - 124: As of version 0.pre7.14, SBCL's implementation of MACROLET makes the entire lexical environment at the point of MACROLET available @@ -693,36 +658,6 @@ WORKAROUND: (call-next-method))) Now (FOO 3) should return 3, but instead it returns 4. -140: - (reported by Alexey Dejneka sbcl-devel 2002-01-03) - - SUBTYPEP does not work well with redefined classes: - --- - * (defclass a () ()) - # - * (defclass b () ()) - # - * (subtypep 'b 'a) - NIL - T - * (defclass b (a) ()) - # - * (subtypep 'b 'a) - T - T - * (defclass b () ()) - # - - ;;; And now... - * (subtypep 'b 'a) - T - T - - This bug was fixed in sbcl-0.7.4.1 by invalidating the PCL wrapper - class upon redefinition. Unfortunately, doing so causes bug #176 to - appear. Pending further investigation, one or other of these bugs - might be present at any given time. - 141: Pretty-printing nested backquotes doesn't work right, as reported by Alexey Dejneka sbcl-devel 2002-01-13: @@ -908,39 +843,6 @@ WORKAROUND: code. Since then the warning has been downgraded to STYLE-WARNING, so it's still a bug but at least it's a little less annoying. -176: - reported by Alexey Dejneka 08 Jun 2002 in sbcl-devel: - Playing with McCLIM, I've received an error "Unbound variable WRAPPER - in SB-PCL::CHECK-WRAPPER-VALIDITY". - (defun check-wrapper-validity (instance) - (let* ((owrapper (wrapper-of instance))) - (if (not (invalid-wrapper-p owrapper)) - owrapper - (let* ((state (wrapper-state wrapper)) ; !!! - ... - I've tried to replace it with OWRAPPER, but now OBSOLETE-INSTANCE-TRAP - breaks with "NIL is not of type SB-KERNEL:LAYOUT". - SBCL 0.7.4.13. - partial fix: The undefined variable WRAPPER resulted from an error - in recent refactoring, as can be seen by comparing to the code in e.g. - sbcl-0.7.2. Replacing WRAPPER with OWRAPPER (done by WHN in sbcl-0.7.4.22) - should bring the code back to its behavior as of sbcl-0.7.2, but - that still leaves the OBSOLETE-INSTANCE-TRAP bug. An example of - input which triggers that bug is - (dotimes (i 20) - (let ((lastname (intern (format nil "C~D" (1- i)))) - (name (intern (format nil "C~D" i)))) - (eval `(defclass ,name - (,@(if (= i 0) nil (list lastname))) - ())) - (eval `(defmethod initialize-instance :after ((x ,name) &rest any) - (declare (ignore any)))))) - (defclass b () ()) - (defclass c0 (b) ()) - (make-instance 'c19) - - See also bug #140. - 178: "AVER failure compiling confused THEs in FUNCALL" In sbcl-0.7.4.24, compiling (defun bug178 (x) @@ -1254,12 +1156,6 @@ WORKAROUND: package: FOO-SLOT". (This is fairly bad code, but still it's hard to see that it should cause symbols to be interned in the CL package.) -209: "DOCUMENTATION generic function has wrong argument precedence order" - (fixed in sbcl-0.7.8.39) - -210: "unsafe evaluation of DEFSTRUCT slot initforms in BOA constructors" - (fixed in sbcl-0.7.8.35) - 211: "keywords processing" a. :ALLOW-OTHER-KEYS T should allow a function to receive an odd number of keyword arguments. @@ -1276,7 +1172,6 @@ WORKAROUND: ; caught STYLE-WARNING: ; The variable #:G15 is defined but never used. - 212: "Sequence functions and circular arguments" COERCE, MERGE and CONCATENATE go into an infinite loop when given circular arguments; it would be good for the user if they could be @@ -1326,7 +1221,7 @@ WORKAROUND: a. FIND and POSITION currently signal errors when given non-NIL for both their :TEST and (deprecated) :TEST-NOT arguments, but by ANSI 17.2 "the consequences are unspecified", which by ANSI 1.4.2 - means that the effect is "unpredictable but harmless. It's not + means that the effect is "unpredictable but harmless". It's not clear what that actually means; it may preclude conforming implementations from signalling errors. b. COUNT, REMOVE and the like give priority to a :TEST-NOT argument diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index c1d9651..548252e 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -578,7 +578,7 @@ (sb-kernel:order-layout-inherits (map 'simple-vector #'class-wrapper (reverse (rest (class-precedence-list class)))))) - (sb-kernel:register-layout layout :invalidate nil) + (sb-kernel:register-layout layout :invalidate t) ;; Subclasses of formerly forward-referenced-class may be ;; unknown to CL:FIND-CLASS and also anonymous. This diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index 006728f..2c0bc38 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -261,44 +261,6 @@ (defmacro wrapper-no-of-instance-slots (wrapper) `(sb-kernel:layout-length ,wrapper)) -;;; WRAPPER-STATE returns T (not generalized boolean, but T exactly) -;;; iff the wrapper is valid. Any other return value denotes some -;;; invalid state. Special conventions have been set up for certain -;;; invalid states, e.g. obsoleteness or flushedness, but I (WHN -;;; 19991204) haven't been motivated to reverse engineer them from the -;;; code and document them here. -;;; -;;; FIXME: We have removed the persistent use of this function throughout -;;; the PCL codebase, instead opting to use INVALID-WRAPPER-P, which -;;; abstractly tests the return result of this function for invalidness. -;;; However, part of the original comment that is still applicable follows. -;;; --njf, 2002-05-02 -;;; -;;; FIXME: It would probably be even better to switch the sense of the -;;; WRAPPER-STATE function, renaming it to WRAPPER-INVALID and making it -;;; synonymous with LAYOUT-INVALID. Then the INVALID-WRAPPER-P function -;;; would become trivial and would go away (replaced with -;;; WRAPPER-INVALID), since all the various invalid wrapper states would -;;; become generalized boolean "true" values. -- WHN 19991204 -#-sb-fluid (declaim (inline wrapper-state (setf wrapper-state))) -(defun wrapper-state (wrapper) - (let ((invalid (sb-kernel:layout-invalid wrapper))) - (cond ((null invalid) - t) - ((atom invalid) - ;; some non-PCL object. INVALID is probably :INVALID. We - ;; should arguably compute the new wrapper here instead of - ;; returning NIL, but we don't bother, since - ;; OBSOLETE-INSTANCE-TRAP can't use it. - '(:obsolete nil)) - (t - invalid)))) -(defun (setf wrapper-state) (new-value wrapper) - (setf (sb-kernel:layout-invalid wrapper) - (if (eq new-value t) - nil - new-value))) - (defmacro wrapper-instance-slots-layout (wrapper) `(%wrapper-instance-slots-layout ,wrapper)) (defmacro wrapper-class-slots (wrapper) @@ -411,63 +373,52 @@ (declaim (inline invalid-wrapper-p)) (defun invalid-wrapper-p (wrapper) - (neq (wrapper-state wrapper) t)) + (not (null (sb-kernel:layout-invalid wrapper)))) (defvar *previous-nwrappers* (make-hash-table)) (defun invalidate-wrapper (owrapper state nwrapper) - (ecase state - ((:flush :obsolete) - (let ((new-previous ())) - ;; First off, a previous call to INVALIDATE-WRAPPER may have - ;; recorded OWRAPPER as an NWRAPPER to update to. Since - ;; OWRAPPER is about to be invalid, it no longer makes sense to - ;; update to it. - ;; - ;; We go back and change the previously invalidated wrappers so - ;; that they will now update directly to NWRAPPER. This - ;; corresponds to a kind of transitivity of wrapper updates. - (dolist (previous (gethash owrapper *previous-nwrappers*)) - (when (eq state :obsolete) - (setf (car previous) :obsolete)) - (setf (cadr previous) nwrapper) - (push previous new-previous)) - - (let ((ocnv (wrapper-cache-number-vector owrapper))) - (dotimes (i sb-kernel:layout-clos-hash-length) - (setf (cache-number-vector-ref ocnv i) 0))) - (push (setf (wrapper-state owrapper) (list state nwrapper)) - new-previous) - - (setf (gethash owrapper *previous-nwrappers*) () - (gethash nwrapper *previous-nwrappers*) new-previous))))) + (aver (member state '(:flush :obsolete) :test #'eq)) + (let ((new-previous ())) + ;; First off, a previous call to INVALIDATE-WRAPPER may have + ;; recorded OWRAPPER as an NWRAPPER to update to. Since OWRAPPER + ;; is about to be invalid, it no longer makes sense to update to + ;; it. + ;; + ;; We go back and change the previously invalidated wrappers so + ;; that they will now update directly to NWRAPPER. This + ;; corresponds to a kind of transitivity of wrapper updates. + (dolist (previous (gethash owrapper *previous-nwrappers*)) + (when (eq state :obsolete) + (setf (car previous) :obsolete)) + (setf (cadr previous) nwrapper) + (push previous new-previous)) + + (let ((ocnv (wrapper-cache-number-vector owrapper))) + (dotimes (i sb-kernel:layout-clos-hash-length) + (setf (cache-number-vector-ref ocnv i) 0))) + + (push (setf (sb-kernel:layout-invalid owrapper) (list state nwrapper)) + new-previous) + + (setf (gethash owrapper *previous-nwrappers*) () + (gethash nwrapper *previous-nwrappers*) new-previous))) (defun check-wrapper-validity (instance) - (let* ((owrapper (wrapper-of instance))) - (if (not (invalid-wrapper-p owrapper)) + (let* ((owrapper (wrapper-of instance)) + (state (sb-kernel:layout-invalid owrapper))) + (if (null state) owrapper - (let* ((state (wrapper-state owrapper)) - (nwrapper - (ecase (car state) - (:flush - (flush-cache-trap owrapper (cadr state) instance)) - (:obsolete - (obsolete-instance-trap owrapper (cadr state) instance))))) - ;; This little bit of error checking is superfluous. It only - ;; checks to see whether the person who implemented the trap - ;; handling screwed up. Since that person is hacking - ;; internal PCL code, and is not a user, this should be - ;; needless. Also, since this directly slows down instance - ;; update and generic function cache refilling, feel free to - ;; take it out sometime soon. - ;; - ;; FIXME: We probably need to add a #+SB-PARANOID feature to - ;; make stuff like this optional. Until then, it stays in. - (cond ((neq nwrapper (wrapper-of instance)) - (error "wrapper returned from trap not wrapper of instance")) - ((invalid-wrapper-p nwrapper) - (error "wrapper returned from trap invalid"))) - nwrapper)))) + (ecase (car state) + (:flush + (flush-cache-trap owrapper (cadr state) instance)) + (:obsolete + (obsolete-instance-trap owrapper (cadr state) instance)))))) + +(declaim (inline check-obsolete-instance)) +(defun check-obsolete-instance (instance) + (when (invalid-wrapper-p (sb-kernel:layout-of instance)) + (check-wrapper-validity instance))) (defvar *free-caches* nil) diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp index 9208b63..273805b 100644 --- a/src/pcl/slots-boot.lisp +++ b/src/pcl/slots-boot.lisp @@ -99,18 +99,21 @@ (etypecase index (fixnum (if fsc-p (lambda (instance) + (check-obsolete-instance instance) (let ((value (clos-slots-ref (fsc-instance-slots instance) index))) (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) value))) (lambda (instance) + (check-obsolete-instance instance) (let ((value (clos-slots-ref (std-instance-slots instance) index))) (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) value))))) (cons (lambda (instance) + (check-obsolete-instance instance) (let ((value (cdr index))) (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) @@ -123,13 +126,15 @@ (etypecase index (fixnum (if fsc-p (lambda (nv instance) + (check-obsolete-instance instance) (setf (clos-slots-ref (fsc-instance-slots instance) index) nv)) (lambda (nv instance) + (check-obsolete-instance instance) (setf (clos-slots-ref (std-instance-slots instance) index) nv)))) (cons (lambda (nv instance) - (declare (ignore instance)) + (check-obsolete-instance instance) (setf (cdr index) nv)))) `(writer ,slot-name))) @@ -139,15 +144,17 @@ (etypecase index (fixnum (if fsc-p (lambda (instance) + (check-obsolete-instance instance) (not (eq (clos-slots-ref (fsc-instance-slots instance) index) +slot-unbound+))) (lambda (instance) + (check-obsolete-instance instance) (not (eq (clos-slots-ref (std-instance-slots instance) index) +slot-unbound+))))) (cons (lambda (instance) - (declare (ignore instance)) + (check-obsolete-instance instance) (not (eq (cdr index) +slot-unbound+))))) `(boundp ,slot-name))) @@ -201,7 +208,7 @@ (fixnum (if fsc-p (lambda (class instance slotd) (declare (ignore slotd)) - (unless (fsc-instance-p instance) (error "not fsc")) + (check-obsolete-instance instance) (let ((value (clos-slots-ref (fsc-instance-slots instance) index))) (if (eq value +slot-unbound+) @@ -209,7 +216,7 @@ value))) (lambda (class instance slotd) (declare (ignore slotd)) - (unless (std-instance-p instance) (error "not std")) + (check-obsolete-instance instance) (let ((value (clos-slots-ref (std-instance-slots instance) index))) (if (eq value +slot-unbound+) @@ -217,6 +224,7 @@ value))))) (cons (lambda (class instance slotd) (declare (ignore slotd)) + (check-obsolete-instance instance) (let ((value (cdr index))) (if (eq value +slot-unbound+) (slot-unbound class instance slot-name) @@ -230,14 +238,17 @@ (fixnum (if fsc-p (lambda (nv class instance slotd) (declare (ignore class slotd)) + (check-obsolete-instance instance) (setf (clos-slots-ref (fsc-instance-slots instance) index) nv)) (lambda (nv class instance slotd) (declare (ignore class slotd)) + (check-obsolete-instance instance) (setf (clos-slots-ref (std-instance-slots instance) index) nv)))) (cons (lambda (nv class instance slotd) - (declare (ignore class instance slotd)) + (declare (ignore class slotd)) + (check-obsolete-instance instance) (setf (cdr index) nv))))) (defun make-optimized-std-slot-boundp-using-class-method-function @@ -248,14 +259,17 @@ (fixnum (if fsc-p (lambda (class instance slotd) (declare (ignore class slotd)) + (check-obsolete-instance instance) (not (eq (clos-slots-ref (fsc-instance-slots instance) index) +slot-unbound+))) (lambda (class instance slotd) (declare (ignore class slotd)) + (check-obsolete-instance instance) (not (eq (clos-slots-ref (std-instance-slots instance) index) +slot-unbound+))))) (cons (lambda (class instance slotd) - (declare (ignore class instance slotd)) + (declare (ignore class slotd)) + (check-obsolete-instance instance) (not (eq (cdr index) +slot-unbound+)))))) (defun get-accessor-from-svuc-method-function (class slotd sdfun name) diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp index e726ba4..aa82a0e 100644 --- a/src/pcl/slots.lisp +++ b/src/pcl/slots.lisp @@ -187,19 +187,14 @@ (defmethod slot-value-using-class ((class std-class) (object std-object) (slotd standard-effective-slot-definition)) + (check-obsolete-instance object) (let* ((location (slot-definition-location slotd)) (value (typecase location (fixnum (cond ((std-instance-p object) - (when (invalid-wrapper-p (std-instance-wrapper - object)) - (check-wrapper-validity object)) (clos-slots-ref (std-instance-slots object) location)) ((fsc-instance-p object) - (when (invalid-wrapper-p (fsc-instance-wrapper - object)) - (check-wrapper-validity object)) (clos-slots-ref (fsc-instance-slots object) location)) (t (error "unrecognized instance type")))) @@ -218,19 +213,16 @@ (new-value (class std-class) (object std-object) (slotd standard-effective-slot-definition)) + (check-obsolete-instance object) (let ((location (slot-definition-location slotd))) (typecase location (fixnum (cond ((std-instance-p object) - (when (invalid-wrapper-p (std-instance-wrapper object)) - (check-wrapper-validity object)) - (setf (clos-slots-ref (std-instance-slots object) location) - new-value)) + (setf (clos-slots-ref (std-instance-slots object) location) + new-value)) ((fsc-instance-p object) - (when (invalid-wrapper-p (fsc-instance-wrapper object)) - (check-wrapper-validity object)) - (setf (clos-slots-ref (fsc-instance-slots object) location) - new-value)) + (setf (clos-slots-ref (fsc-instance-slots object) location) + new-value)) (t (error "unrecognized instance type")))) (cons (setf (cdr location) new-value)) @@ -243,19 +235,14 @@ ((class std-class) (object std-object) (slotd standard-effective-slot-definition)) + (check-obsolete-instance object) (let* ((location (slot-definition-location slotd)) (value (typecase location (fixnum (cond ((std-instance-p object) - (when (invalid-wrapper-p (std-instance-wrapper - object)) - (check-wrapper-validity object)) (clos-slots-ref (std-instance-slots object) location)) ((fsc-instance-p object) - (when (invalid-wrapper-p (fsc-instance-wrapper - object)) - (check-wrapper-validity object)) (clos-slots-ref (fsc-instance-slots object) location)) (t (error "unrecognized instance type")))) @@ -272,19 +259,16 @@ ((class std-class) (object std-object) (slotd standard-effective-slot-definition)) + (check-obsolete-instance object) (let ((location (slot-definition-location slotd))) (typecase location (fixnum (cond ((std-instance-p object) - (when (invalid-wrapper-p (std-instance-wrapper object)) - (check-wrapper-validity object)) - (setf (clos-slots-ref (std-instance-slots object) location) - +slot-unbound+)) + (setf (clos-slots-ref (std-instance-slots object) location) + +slot-unbound+)) ((fsc-instance-p object) - (when (invalid-wrapper-p (fsc-instance-wrapper object)) - (check-wrapper-validity object)) - (setf (clos-slots-ref (fsc-instance-slots object) location) - +slot-unbound+)) + (setf (clos-slots-ref (fsc-instance-slots object) location) + +slot-unbound+)) (t (error "unrecognized instance type")))) (cons (setf (cdr location) +slot-unbound+)) diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 1c22ac9..ef6f9cf 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -1050,12 +1050,17 @@ (defun force-cache-flushes (class) (let* ((owrapper (class-wrapper class))) - ;; We only need to do something if the state is still T. If the - ;; state isn't T, it will be FLUSH or OBSOLETE, and both of those - ;; will already be doing what we want. In particular, we must be - ;; sure we never change an OBSOLETE into a FLUSH since OBSOLETE - ;; means do what FLUSH does and then some. - (unless (invalid-wrapper-p owrapper) + ;; We only need to do something if the wrapper is still valid. If + ;; the wrapper isn't valid, state will be FLUSH or OBSOLETE, and + ;; both of those will already be doing what we want. In + ;; particular, we must be sure we never change an OBSOLETE into a + ;; FLUSH since OBSOLETE means do what FLUSH does and then some. + (when (or (not (invalid-wrapper-p owrapper)) + ;; Ick. LAYOUT-INVALID can return a list (which we can + ;; handle), T (which we can't), NIL (which is handled by + ;; INVALID-WRAPPER-P) or :UNINITIALIZED (which never + ;; gets here (I hope). -- CSR, 2002-10-28 + (eq (sb-kernel:layout-invalid owrapper) t)) (let ((nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper) class))) (setf (wrapper-instance-slots-layout nwrapper) diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index ffdbd3b..b08b1d9 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -327,6 +327,21 @@ (assert (eq (no-next-method-test 1) 'success)) (assert (null (ignore-errors (no-next-method-test 'foo)))) +;;; regression test for bug 176, following a fix that seems +;;; simultaneously to fix 140 while not exposing 176 (by Gerd +;;; Moellmann, merged in sbcl-0.7.9.12). +(dotimes (i 10) + (let ((lastname (intern (format nil "C176-~D" (1- i)))) + (name (intern (format nil "C176-~D" i)))) + (eval `(defclass ,name + (,@(if (= i 0) nil (list lastname))) + ())) + (eval `(defmethod initialize-instance :after ((x ,name) &rest any) + (declare (ignore any)))))) +(defclass b176 () (aslot-176)) +(defclass c176-0 (b176) ()) +(assert (= 1 (setf (slot-value (make-instance 'c176-9) 'aslot-176) 1))) + ;;;; success (sb-ext:quit :unix-status 104) diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp index 13ee083..adb9bf6 100644 --- a/tests/type.impure.lisp +++ b/tests/type.impure.lisp @@ -339,14 +339,14 @@ (tests-of-inline-type-tests) (format t "~&/done with compiled (TESTS-OF-INLINE-TYPE-TESTS)~%") -#|| Pending fix for bug 176, bug 140 has been unfixed ;;; Redefinition of classes should alter the type hierarchy (BUG 140): (defclass superclass () ()) +(defclass maybe-subclass () ()) +(assert-nil-t (subtypep 'maybe-subclass 'superclass)) (defclass maybe-subclass (superclass) ()) (assert-t-t (subtypep 'maybe-subclass 'superclass)) (defclass maybe-subclass () ()) (assert-nil-t (subtypep 'maybe-subclass 'superclass)) -||# ;;; Prior to sbcl-0.7.6.27, there was some confusion in ARRAY types ;;; specialized on some as-yet-undefined type which would cause this diff --git a/version.lisp-expr b/version.lisp-expr index 45e891e..4f7fb70 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.9.11" +"0.7.9.12" -- 1.7.10.4