From: Christophe Rhodes Date: Sun, 1 Jun 2003 11:15:54 +0000 (+0000) Subject: 0.8.0.23: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e13730f246bc1f6b4fab39479f4e50534283dac1;p=sbcl.git 0.8.0.23: Fix a couple of bugs from Paul Dietz' test suite ... multiple class/superclass redefinitions can leave a layout with an INVALID value of T; this case needs to be handled in CHECK-WRAPPER-VALIDITY. (thanks to Gerd Moellmann) ... (SETF FIND-CLASS) will eventually pass NIL to (SETF FIND-CLASSOID), so that had better be able to handle it. --- diff --git a/BUGS b/BUGS index cace3b3..d76b41b 100644 --- a/BUGS +++ b/BUGS @@ -199,19 +199,6 @@ WORKAROUND: (Also, verify that the compiler handles declared function return types as assertions.) -41: - TYPEP of VALUES types is sometimes implemented very inefficiently, e.g. in - (DEFTYPE INDEXOID () '(INTEGER 0 1000)) - (DEFUN FOO (X) - (DECLARE (TYPE INDEXOID X)) - (THE (VALUES INDEXOID) - (VALUES X))) - where the implementation of the type check in function FOO - includes a full call to %TYPEP. There are also some fundamental problems - with the interpretation of VALUES types (inherited from CMU CL, and - from the ANSI CL standard) as discussed on the cmucl-imp@cons.org - mailing list, e.g. in Robert Maclachlan's post of 21 Jun 2000. - 42: The definitions of SIGCONTEXT-FLOAT-REGISTER and %SET-SIGCONTEXT-FLOAT-REGISTER in x86-vm.lisp say they're not @@ -926,15 +913,6 @@ WORKAROUND: to redo MIX using a lookup into a 256-entry s-box containing 29-bit pseudorandom numbers? -208: "package confusion in PCL handling of structure slot handlers" - In sbcl-0.7.8 compiling and loading - (in-package :cl) - (defstruct foo (slot (error "missing")) :type list :read-only t) - (defmethod print-object ((foo foo) stream) (print nil stream)) - causes CERROR "attempting to modify a symbol in the COMMON-LISP - 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.) - 211: "keywords processing" a. :ALLOW-OTHER-KEYS T should allow a function to receive an odd number of keyword arguments. @@ -1046,12 +1024,6 @@ WORKAROUND: produce invalid code, but type checking is not accurate. Similar problems exist with VALUES-TYPE-INTERSECTION.) -218: "VALUES type specifier semantics" - (THE (VALUES ...) ...) in safe code discards extra values. - - (defun test (x y) (the (values integer) (truncate x y))) - (test 10 4) => 2 - 220: Sbcl 0.7.9 fails to compile @@ -1066,9 +1038,6 @@ WORKAROUND: would be to put the check between evaluation of arguments, but it could be tricky to check result types of PROG1, IF etc. -229: - (subtypep 'function '(function)) => nil, t. - 233: bugs in constraint propagation a. (defun foo (x) diff --git a/NEWS b/NEWS index fb780f3..b140ecf 100644 --- a/NEWS +++ b/NEWS @@ -1793,6 +1793,10 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0: ** NIL is now allowed as a structure slot name. ** arbitrary numbers, not just reals, are allowed in certain circumstances in LOOP for-as-arithmetic clauses. + ** multiple class redefinitions before slot access no longer + causes a type error. + ** (SETF FIND-CLASS) now accepts NIL as an argument to remove the + association between the name and a class. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/code/class.lisp b/src/code/class.lisp index 0d19c7c..16a7609 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -715,50 +715,64 @@ res (error "class not yet defined:~% ~S" name)))) (defun (setf find-classoid) (new-value name) - #-sb-xc (declare (type classoid new-value)) - (ecase (info :type :kind name) - ((nil)) - (:forthcoming-defclass-type - ;; XXX Currently, nothing needs to be done in this case. Later, when - ;; PCL is integrated tighter into SBCL, this might need more work. - nil) - (:instance - ;; KLUDGE: The reason these clauses aren't directly parallel is - ;; that we need to use the internal CLASSOID structure ourselves, - ;; because we don't have CLASSes to work with until PCL is built. - ;; In the host, CLASSes have an approximately one-to-one - ;; correspondence with the target CLASSOIDs (as well as with the - ;; target CLASSes, modulo potential differences with respect to - ;; conditions). - #+sb-xc-host - (let ((old (class-of (find-classoid name))) - (new (class-of new-value))) - (unless (eq old new) - (bug "trying to change the metaclass of ~S from ~S to ~S in the ~ - cross-compiler." - name (class-name old) (class-name new)))) - #-sb-xc-host - (let ((old (classoid-of (find-classoid name))) - (new (classoid-of new-value))) - (unless (eq old new) - (warn "changing meta-class of ~S from ~S to ~S" - name (classoid-name old) (classoid-name new))))) - (:primitive - (error "illegal to redefine standard type ~S" name)) - (:defined - (warn "redefining DEFTYPE type to be a class: ~S" name) - (setf (info :type :expander name) nil))) + #-sb-xc (declare (type (or null classoid) new-value)) + (cond + ((null new-value) + (ecase (info :type :kind name) + ((nil)) + (:defined) + (:primitive + (error "attempt to redefine :PRIMITIVE type: ~S" name)) + ((:forthcoming-defclass-type :instance) + (setf (info :type :kind name) nil + (info :type :classoid name) nil + (info :type :documentation name) nil + (info :type :compiler-layout name) nil)))) + (t + (ecase (info :type :kind name) + ((nil)) + (:forthcoming-defclass-type + ;; XXX Currently, nothing needs to be done in this + ;; case. Later, when PCL is integrated tighter into SBCL, this + ;; might need more work. + nil) + (:instance + ;; KLUDGE: The reason these clauses aren't directly parallel + ;; is that we need to use the internal CLASSOID structure + ;; ourselves, because we don't have CLASSes to work with until + ;; PCL is built. In the host, CLASSes have an approximately + ;; one-to-one correspondence with the target CLASSOIDs (as + ;; well as with the target CLASSes, modulo potential + ;; differences with respect to conditions). + #+sb-xc-host + (let ((old (class-of (find-classoid name))) + (new (class-of new-value))) + (unless (eq old new) + (bug "trying to change the metaclass of ~S from ~S to ~S in the ~ + cross-compiler." + name (class-name old) (class-name new)))) + #-sb-xc-host + (let ((old (classoid-of (find-classoid name))) + (new (classoid-of new-value))) + (unless (eq old new) + (warn "changing meta-class of ~S from ~S to ~S" + name (classoid-name old) (classoid-name new))))) + (:primitive + (error "illegal to redefine standard type ~S" name)) + (:defined + (warn "redefining DEFTYPE type to be a class: ~S" name) + (setf (info :type :expander name) nil))) - (remhash name *forward-referenced-layouts*) - (%note-type-defined name) - (setf (info :type :kind name) :instance) - (setf (classoid-cell-classoid (find-classoid-cell name)) new-value) - (unless (eq (info :type :compiler-layout name) - (classoid-layout new-value)) - (setf (info :type :compiler-layout name) (classoid-layout new-value))) + (remhash name *forward-referenced-layouts*) + (%note-type-defined name) + (setf (info :type :kind name) :instance) + (setf (classoid-cell-classoid (find-classoid-cell name)) new-value) + (unless (eq (info :type :compiler-layout name) + (classoid-layout new-value)) + (setf (info :type :compiler-layout name) (classoid-layout new-value))))) new-value) ) ; EVAL-WHEN - + ;;; Called when we are about to define NAME as a class meeting some ;;; predicate (such as a meta-class type test.) The first result is ;;; always of the desired class. The second result is any existing diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index d53c674..ed83efd 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -353,13 +353,29 @@ (defun check-wrapper-validity (instance) (let* ((owrapper (wrapper-of instance)) (state (layout-invalid owrapper))) - (if (null state) - owrapper - (ecase (car state) - (:flush - (flush-cache-trap owrapper (cadr state) instance)) - (:obsolete - (obsolete-instance-trap owrapper (cadr state) instance)))))) + (aver (not (eq state :uninitialized))) + (etypecase state + (null owrapper) + ;; FIXME: I can't help thinking that, while this does cure the + ;; symptoms observed from some class redefinitions, this isn't + ;; the place to be doing this flushing. Nevertheless... -- + ;; CSR, 2003-05-31 + ;; + ;; CMUCL comment: + ;; We assume in this case, that the :INVALID is from a + ;; 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. + ((member t) + (let ((class (class-of instance))) + (force-cache-flushes class) + (class-wrapper class))) + (cons + (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) diff --git a/version.lisp-expr b/version.lisp-expr index 6d1577e..88827d4 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.0.22" +"0.8.0.23"