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
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 #<PACKAGE "SB-ALIEN">.
- Macro-function: #<FUNCTION "DEF!MACRO DEF-ALIEN-TYPE" {19F4A39}>
- 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:
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
(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 () ())
- #<STANDARD-CLASS A>
- * (defclass b () ())
- #<STANDARD-CLASS B>
- * (subtypep 'b 'a)
- NIL
- T
- * (defclass b (a) ())
- #<STANDARD-CLASS B>
- * (subtypep 'b 'a)
- T
- T
- * (defclass b () ())
- #<STANDARD-CLASS 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:
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)
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.
; 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
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
(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
(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)
(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)))
\f
(defvar *free-caches* nil)
(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)
(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)))
(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)))
(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+)
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+)
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)
(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
(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)
(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"))))
(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))
((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"))))
((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+))
\f
(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)
(assert (eq (no-next-method-test 1) 'success))
(assert (null (ignore-errors (no-next-method-test 'foo))))
\f
+;;; 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)))
+\f
;;;; success
(sb-ext:quit :unix-status 104)
(tests-of-inline-type-tests)
(format t "~&/done with compiled (TESTS-OF-INLINE-TYPE-TESTS)~%")
\f
-#|| 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))
-||#
\f
;;; 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
;;; 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"
projects / sbcl.git / commitdiff