From: William Harold Newman Date: Thu, 14 Feb 2002 03:38:06 +0000 (+0000) Subject: 0.7.1.19: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=63cef087068afc157283c0a05ae1f16b962303aa;p=sbcl.git 0.7.1.19: (I thought I did this in 0.7.1.13, but it appears that I didn't, so try again:) made :ENCAPSULATE T the default for TRACE, since the breakpoint-based version still doesn't work reliably and since the ANSI description of TRACE is partial to tracing named things anyway merged MNA "patch for bug 149" sbcl-devel 2002-02-08 tweaking MNA patch... ...s/:defclass-type/:forthcoming-defclass-type/ ...s/inform-compiler/preinform-compiler/ ...made the :UNDEFINED-DEFCLASS-TYPE not overwrite an existing ordinary class type (e.g. from previously LOADing an earlier version of the compiled file) ...removed the old arcane conditionalization on INFORM-COMPILER-ABOUT-CLASS-TYPE ...moved the definition of PREINFORM-COMPILER-ABOUT-CLASS-TYPE earlier (since removal of conditionalization above causes it to be called earlier) ...bumped fasl file version pedanticated special variable names which're used only within DEFCLASS... ...s/\*initfunctions/initfunctions-for-this-defclass/ ...s/\*readers\*/*readers-for-this-defclass*/ ...s/\*writers\*/*writers-for-this-defclass*/ ...(Use DEFVAR instead of DECLARE SPECIAL for them, too.) deleted unused DEFUN MAKE-PROGN --- diff --git a/BUGS b/BUGS index 115b769..0f4e0ce 100644 --- a/BUGS +++ b/BUGS @@ -1261,17 +1261,6 @@ WORKAROUND: issues were cleaned up. As of sbcl-0.7.1.9, it occurs in NODE-BLOCK called by LAMBDA-COMPONENT called by IR2-CONVERT-CLOSURE. -149: - (reported by Stig E Sandoe sbcl-devel 2002-02-02) - In sbcl-0.7.1.13, compiling a DEFCLASS FOO form isn't enough to make - the class known to the compiler for other forms compiled in the same - file, so bogus warnings "undefined type: FOO" are generated, e.g. - when compiling - (in-package :cl-user) - (defclass foo () ()) - (defun bar (x) - (typep x 'foo)) - 150: In sbcl-0.7.1.15, compiling this code (let* () @@ -1297,8 +1286,21 @@ WORKAROUND: (error "not ~S" '(eql (lo foomax 3.2)))) (values)))) +151: + From the ANSI description of GET-DISPATCH-MACRO-CHARACTER, it + should return NIL when there is no definition, e.g. + (GET-DISPATCH-MACRO-CHARACTER #\# #\{) => NIL + Instead, in sbcl-0.7.1.17 it returns + # + +152: + Undefined functions are supposed to be reported as UNDEFINED-FUNCTION + conditions, inheriting from CELL-ERROR. Instead sbcl-0.7.1.19 reports + them as TYPE-ERRORs (reporting the problem as something not being + coerceable to a function). + + DEFUNCT CATEGORIES OF BUGS IR1-#: - These labels were used for bugs related to the old IR1 - interpreter. The # values reached 6 before the category - was closed down. \ No newline at end of file + These labels were used for bugs related to the old IR1 interpreter. + The # values reached 6 before the category was closed down. \ No newline at end of file diff --git a/NEWS b/NEWS index 276ab6d..0a0ad46 100644 --- a/NEWS +++ b/NEWS @@ -1014,10 +1014,13 @@ changes in sbcl-0.7.2 relative to sbcl-0.7.1: an alternate notation for --eval '(load "foo.bar")'. * bug fixes: ** The system now hunts for the C variable "environ" in a more - devious way, to avoid segfaults when the C library version - differs between compile time and run time. (thanks to Christophe - Rhodes) + devious way, to avoid segfaults when the C library version differs + between compile time and run time. (thanks to Christophe Rhodes) ** INTEGER-valued CATCH tags now work. (thanks to Alexey Dejneka) + ** The compiler no longer issues bogus style warnings for undefined + classes in the same source file as the DEFCLASSes which defined + them. (thanks to Stig E Sandoe for reporting and Martin Atzmueller + for fixing this) * several changes related to debugging: ** suppression of tail recursion, as noted above ** The default implementation of TRACE has changed. :ENCAPSULATE T diff --git a/src/code/class.lisp b/src/code/class.lisp index 913a541..a3e8f69 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -735,6 +735,10 @@ #-sb-xc (declare (type sb!xc:class 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 (let ((old (class-of (sb!xc:find-class name))) (new (class-of new-value))) diff --git a/src/code/condition.lisp b/src/code/condition.lisp index ba29887..9b68c2b 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -1,8 +1,6 @@ ;;;; stuff originally from CMU CL's error.lisp which can or should ;;;; come late (mostly related to the CONDITION class itself) ;;;; -;;;; FIXME: should perhaps be called condition.lisp, or moved into -;;;; classes.lisp ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 12f4e4f..a6dd6b5 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -42,7 +42,7 @@ ;;; versions which break binary compatibility. But it certainly should ;;; be incremented for release versions which break binary ;;; compatibility. -(defconstant +fasl-file-version+ 23) +(defconstant +fasl-file-version+ 24) ;;; 2 = sbcl-0.6.4 uses COMPILE-OR-LOAD-DEFGENERIC. ;;; 3 = sbcl-0.6.6 uses private symbol, not :EMPTY, for empty HASH-TABLE slot. ;;; 4 = sbcl-0.6.7 uses HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET @@ -95,6 +95,8 @@ ;;; trouble to increment the counter ;;; 23 = sbcl-0.7.0.1 deleted no-longer-used EVAL-STACK stuff, ;;; causing changes in *STATIC-SYMBOLS*. +;;; 24 = sbcl-0.7.1.19 changed PCL service routines which might be +;;; called from macroexpanded code ;;; the conventional file extension for our fasl files (declaim (type simple-string *fasl-file-type*)) diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 2a40aed..5e21ecf 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -304,12 +304,7 @@ ;;; type is defined (or redefined). (defun-cached (values-specifier-type :hash-function (lambda (x) - ;; FIXME: The THE FIXNUM stuff is - ;; redundant in SBCL (or modern CMU - ;; CL) because of type inference. - (the fixnum - (logand (the fixnum (sxhash x)) - #x3FF))) + (logand (sxhash x) #x3FF)) :hash-bits 10 :init-wrapper !cold-init-forms) ((orig eq)) @@ -343,7 +338,9 @@ (funcall fun lspec)) ((or (and (consp spec) (symbolp (car spec))) (symbolp spec)) - (when *type-system-initialized* + (when (and *type-system-initialized* + (not (eq (info :type :kind spec) + :forthcoming-defclass-type))) (signal 'parse-unknown-type :specifier spec)) ;; (The RETURN-FROM here inhibits caching.) (return-from values-specifier-type diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index 6535280..62979c3 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -29,7 +29,7 @@ "If the trace indentation exceeds this value, then indentation restarts at 0.") -(defvar *trace-encapsulate-default* nil +(defvar *trace-encapsulate-default* t #+sb-doc "the default value for the :ENCAPSULATE option to TRACE") diff --git a/src/compiler/compiler-deftype.lisp b/src/compiler/compiler-deftype.lisp index 44a0c44..20b08b5 100644 --- a/src/compiler/compiler-deftype.lisp +++ b/src/compiler/compiler-deftype.lisp @@ -36,7 +36,7 @@ ;; since mistakenly redefining a type isn't a common error ;; anyway, we just don't worry about trying to warn about it. ) - ((nil) + ((nil :forthcoming-defclass-type) (setf (info :type :kind name) :defined))) (setf (info :type :expander name) expander) (when doc diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 682cd9f..7e13d0f 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -1204,11 +1204,14 @@ (define-info-class :type) ;;; the kind of type described. We return :INSTANCE for standard types -;;; that are implemented as structures. +;;; that are implemented as structures. For PCL classes, that have +;;; only been compiled, but not loaded yet, we return +;;; :FORTHCOMING-DEFCLASS-TYPE. (define-info-type :class :type :type :kind - :type-spec (member :primitive :defined :instance nil) + :type-spec (member :primitive :defined :instance + :forthcoming-defclass-type nil) :default nil) ;;; the expander function for a defined type @@ -1245,7 +1248,7 @@ ;;; If this is a class name, then the value is a cons (NAME . CLASS), ;;; where CLASS may be null if the class hasn't been defined yet. Note ;;; that for built-in classes, the kind may be :PRIMITIVE and not -;;; :INSTANCE. The the name is in the cons so that we can signal a +;;; :INSTANCE. The name is in the cons so that we can signal a ;;; meaningful error if we only have the cons. (define-info-type :class :type diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index de4c4b6..ca67036 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -145,10 +145,7 @@ (built-in-class built-in-class-wrapper) (structure-class structure-class-wrapper))) (class (or (find-class name nil) - (allocate-standard-instance wrapper)))) - (when (or (eq meta 'standard-class) - (eq meta 'funcallable-standard-class)) - (inform-type-system-about-std-class name)) + (allocate-standard-instance wrapper)))) (setf (find-class name) class))) (dolist (definition *early-class-definitions*) (let ((name (ecd-class-name definition)) diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp index a0f3cd3..99f2f7a 100644 --- a/src/pcl/defclass.lisp +++ b/src/pcl/defclass.lisp @@ -23,18 +23,32 @@ (in-package "SB-PCL") -(defun make-progn (&rest forms) - (let ((progn-form nil)) - (labels ((collect-forms (forms) - (unless (null forms) - (collect-forms (cdr forms)) - (if (and (listp (car forms)) - (eq (caar forms) 'progn)) - (collect-forms (cdar forms)) - (push (car forms) progn-form))))) - (collect-forms forms) - (cons 'progn progn-form)))) - +;;;; DEFCLASS macro and close personal friends + +;;; ANSI says (Macro DEFCLASS, section 7.7) that DEFCLASS, if it +;;; "appears as a top level form, the compiler must make the class +;;; name be recognized as a valid type name in subsequent declarations +;;; (as for deftype) and be recognized as a valid class name for +;;; defmethod parameter specializers and for use as the :metaclass +;;; option of a subsequent defclass." +(defun preinform-compiler-about-class-type (name) + ;; Unless the type system already has an actual type attached to + ;; NAME (in which case (1) writing a placeholder value over that + ;; actual type as a compile-time side-effect would probably be a bad + ;; idea and (2) anyway we don't need to modify it in order to make + ;; NAME be recognized as a valid type name) + (unless (info :type :kind name) + ;; Tell the compiler to expect a class with the given NAME, by + ;; writing a kind of minimal placeholder type information. This + ;; placeholder will be overwritten later when the class is defined. + (setf (info :type :kind name) :forthcoming-defclass-type)) + (values)) + +;;; state for the current DEFCLASS expansion +(defvar *initfunctions-for-this-defclass*) +(defvar *readers-for-this-defclass*) +(defvar *writers-for-this-defclass*) + ;;; Like the DEFMETHOD macro, the expansion of the DEFCLASS macro is ;;; fixed. DEFCLASS always expands into a call to LOAD-DEFCLASS. Until ;;; the meta-braid is set up, LOAD-DEFCLASS has a special definition @@ -65,10 +79,9 @@ (setf options (remove option options)) (return t)))) - (let ((*initfunctions* ()) - (*readers* ()) ;Truly a crock, but we got - (*writers* ())) ;to have it to live nicely. - (declare (special *initfunctions* *readers* *writers*)) + (let ((*initfunctions-for-this-defclass* ()) + (*readers-for-this-defclass* ()) ;Truly a crock, but we got + (*writers-for-this-defclass* ())) ;to have it to live nicely. (let ((canonical-slots (mapcar (lambda (spec) (canonicalize-slot-specification name spec)) @@ -77,9 +90,9 @@ (mapcar (lambda (option) (canonicalize-defclass-option name option)) options)) - ;; DEFSTRUCT-P should be true, if the class is defined with a - ;; metaclass STRUCTURE-CLASS, such that a DEFSTRUCT is compiled - ;; for the class. + ;; DEFSTRUCT-P should be true if the class is defined + ;; with a metaclass STRUCTURE-CLASS, so that a DEFSTRUCT + ;; is compiled for the class. (defstruct-p (and (eq *boot-state* 'complete) (let ((mclass (find-class metaclass nil))) (and mclass @@ -87,70 +100,50 @@ mclass *the-class-structure-class*)))))) (let ((defclass-form - `(progn - ,@(mapcar (lambda (x) - `(declaim (ftype (function (t) t) ,x))) - *readers*) - ,@(mapcar (lambda (x) - `(declaim (ftype (function (t t) t) ,x))) - *writers*) - (let ,(mapcar #'cdr *initfunctions*) - (load-defclass ',name - ',metaclass - ',supers - (list ,@canonical-slots) - (list ,@(apply #'append - (when defstruct-p - '(:from-defclass-p t)) - other-initargs))))))) + `(progn + ,@(mapcar (lambda (x) + `(declaim (ftype (function (t) t) ,x))) + *readers-for-this-defclass*) + ,@(mapcar (lambda (x) + `(declaim (ftype (function (t t) t) ,x))) + *writers-for-this-defclass*) + (let ,(mapcar #'cdr *initfunctions-for-this-defclass*) + (load-defclass ',name + ',metaclass + ',supers + (list ,@canonical-slots) + (list ,@(apply #'append + (when defstruct-p + '(:from-defclass-p t)) + other-initargs))))))) (if defstruct-p - (let* ((include (or (and supers - (fix-super (car supers))) - (and (not (eq name 'structure-object)) - *the-class-structure-object*))) - (defstruct-form (make-structure-class-defstruct-form - name slots include))) - `(progn - (eval-when (:compile-toplevel :load-toplevel :execute) - ,defstruct-form) ; really compile the defstruct-form - (eval-when (:compile-toplevel :load-toplevel :execute) - ,defclass-form))) - `(progn - ;; By telling the type system at compile time about - ;; the existence of a class named NAME, we can avoid - ;; various bogus warnings about "type isn't defined yet" - ;; for code elsewhere in the same file which uses - ;; the name of the type. - ,(when (and - ;; But it's not so important to get rid of - ;; "not defined yet" warnings during - ;; bootstrapping, and machinery like - ;; INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS - ;; mightn't be defined yet. So punt then. - (eq *boot-state* 'complete) - ;; And although we know enough about - ;; STANDARD-CLASS, and ANSI imposes enough - ;; restrictions on the user overloading its - ;; methods, that (1) we can shortcut the - ;; method dispatch and do an ordinary - ;; function call, and (2) be sure we're getting - ;; it right even when we do it at compile - ;; time; we don't in general know how to do - ;; that for other classes. So punt then too. - (eq metaclass 'standard-class)) - `(eval-when (:compile-toplevel) - ;; we only need :COMPILE-TOPLEVEL here, because this - ;; should happen in the compile-time environment - ;; only. - ;; Later, INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS is - ;; called by way of LOAD-DEFCLASS (calling - ;; ENSURE-CLASS-USING-CLASS) to establish the 'real' - ;; type predicate. - (inform-type-system-about-std-class ',name))) - ,defclass-form)))))))) + (let* ((include (or (and supers + (fix-super (car supers))) + (and (not (eq name 'structure-object)) + *the-class-structure-object*))) + (defstruct-form (make-structure-class-defstruct-form + name slots include))) + `(progn + (eval-when (:compile-toplevel :load-toplevel :execute) + ,defstruct-form) ; really compile the defstruct-form + (eval-when (:compile-toplevel :load-toplevel :execute) + ,defclass-form))) + `(progn + ;; By telling the type system at compile time about + ;; the existence of a class named NAME, we can avoid + ;; various bogus warnings about "type isn't defined yet" + ;; for code elsewhere in the same file which uses + ;; the name of the type. + ;; + ;; We only need to do this at compile time, because + ;; at load and execute time we write the actual + ;; full-blown class, so the "a class of this name is + ;; coming" note we write here would be irrelevant. + (eval-when (:compile-toplevel) + (preinform-compiler-about-class-type ',name)) + ,defclass-form)))))))) (defun make-initfunction (initform) - (declare (special *initfunctions*)) (cond ((or (eq initform t) (equal initform ''t)) '(function constantly-t)) @@ -161,16 +154,16 @@ (equal initform ''0)) '(function constantly-0)) (t - (let ((entry (assoc initform *initfunctions* :test #'equal))) + (let ((entry (assoc initform *initfunctions-for-this-defclass* + :test #'equal))) (unless entry (setq entry (list initform (gensym) `(function (lambda () ,initform)))) - (push entry *initfunctions*)) + (push entry *initfunctions-for-this-defclass*)) (cadr entry))))) (defun canonicalize-slot-specification (class-name spec) - (declare (special *readers* *writers*)) (cond ((and (symbolp spec) (not (keywordp spec)) (not (memq spec '(t nil)))) @@ -201,8 +194,10 @@ (loop (unless (remf spec :reader) (return))) (loop (unless (remf spec :writer) (return))) (loop (unless (remf spec :initarg) (return))) - (setq *writers* (append writers *writers*)) - (setq *readers* (append readers *readers*)) + (setq *writers-for-this-defclass* + (append writers *writers-for-this-defclass*)) + (setq *readers-for-this-defclass* + (append readers *readers-for-this-defclass*)) (setq spec `(:name ',name :readers ',readers :writers ',writers @@ -228,9 +223,9 @@ (otherwise `(',(car option) ',(cdr option))))) -;;; This is the early definition of load-defclass. It just collects up -;;; all the class definitions in a list. Later, in the file -;;; braid1.lisp, these are actually defined. +;;; This is the early definition of LOAD-DEFCLASS. It just collects up +;;; all the class definitions in a list. Later, in braid1.lisp, these +;;; are actually defined. ;;; Each entry in *EARLY-CLASS-DEFINITIONS* is an EARLY-CLASS-DEFINITION. (defparameter *early-class-definitions* ()) @@ -378,8 +373,6 @@ (setq supers (copy-tree supers) canonical-slots (copy-tree canonical-slots) canonical-options (copy-tree canonical-options)) - (when (eq metaclass 'standard-class) - (inform-type-system-about-std-class name)) (let ((ecd (make-early-class-definition name *load-truename* diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index 4df534a..2ec1da6 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -187,29 +187,6 @@ (defun class-eq-type (class) (specializer-type (class-eq-specializer class))) -(defun inform-type-system-about-std-class (name) - (let ((predicate-name (make-type-predicate-name name))) - (setf (gdefinition predicate-name) - (make-type-predicate name)))) - -(defun make-type-predicate (name) - (let ((cell (find-class-cell name))) - (lambda (x) - (funcall (the function (find-class-cell-predicate cell)) x)))) - -(defun make-type-predicate-name (name &optional kind) - (if (symbol-package name) - (intern (format nil - "~@[~A ~]TYPE-PREDICATE ~A ~A" - kind - (package-name (symbol-package name)) - (symbol-name name)) - *pcl-package*) - (make-symbol (format nil - "~@[~A ~]TYPE-PREDICATE ~A" - kind - (symbol-name name))))) - ;;; internal to this file.. ;;; ;;; These functions are a pale imitation of their namesake. They accept @@ -537,7 +514,7 @@ (:metaclass std-class)) ;;; The class CLASS is a specified basic class. It is the common -;;; superclass of any kind of class. That is any class that can be a +;;; superclass of any kind of class. That is, any class that can be a ;;; metaclass must have the class CLASS in its class precedence list. (defclass class (documentation-mixin dependent-update-mixin @@ -553,6 +530,9 @@ (direct-superclasses :initform () :reader class-direct-superclasses) + ;; Note: The (CLASS-)DIRECT-SUBCLASSES for STRUCTURE-CLASSes and + ;; CONDITION-CLASSes are lazily computed whenever the subclass info + ;; becomes available, i.e. when the PCL class is created. (direct-subclasses :initform () :reader class-direct-subclasses) diff --git a/src/pcl/describe.lisp b/src/pcl/describe.lisp index e04d40c..dc49e92 100644 --- a/src/pcl/describe.lisp +++ b/src/pcl/describe.lisp @@ -59,7 +59,7 @@ (:class (push slotd class-slotds)) (otherwise (push slotd other-slotds)))) (setq max-slot-name-length (min (+ max-slot-name-length 3) 30)) - (format stream "~%~@<~S ~_is an instance of class ~S.~:>" object class) + (format stream "~&~@<~S ~_is an instance of class ~S.~:>" object class) ;; Now that we know the width, we can print. (when instance-slotds diff --git a/src/pcl/generic-functions.lisp b/src/pcl/generic-functions.lisp index 8cb3e01..0b45a7a 100644 --- a/src/pcl/generic-functions.lisp +++ b/src/pcl/generic-functions.lisp @@ -335,8 +335,6 @@ (defgeneric effective-slot-definition-class (class initargs)) -(defgeneric inform-type-system-about-class (class name)) - (defgeneric legal-documentation-p (object x)) (defgeneric legal-method-function-p (object x)) diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 6b9f967..8dd9ea1 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -338,7 +338,6 @@ (ensure-class-values class args) (setf class (apply #'make-instance meta :name name initargs) (find-class name) class) - (inform-type-system-about-class class name) class)) (defmethod ensure-class-using-class (name (class pcl-class) &rest args &key) @@ -347,7 +346,6 @@ (unless (eq (class-of class) meta) (change-class class meta)) (apply #'reinitialize-instance class initargs) (setf (find-class name) class) - (inform-type-system-about-class class name) class)) (defmethod class-predicate-name ((class t)) @@ -631,14 +629,14 @@ (dolist (r (slot-definition-readers dslotd)) (fix r slot-name 'r)) (dolist (w (slot-definition-writers dslotd)) (fix w slot-name 'w)))))) -(defun add-direct-subclasses (class new) - (dolist (n new) +(defun add-direct-subclasses (class supers) + (dolist (super supers) (unless (memq class (class-direct-subclasses class)) - (add-direct-subclass n class)))) + (add-direct-subclass super class)))) -(defun remove-direct-subclasses (class new) +(defun remove-direct-subclasses (class supers) (let ((old (class-direct-superclasses class))) - (dolist (o (set-difference old new)) + (dolist (o (set-difference old supers)) (remove-direct-subclass o class)))) (defmethod finalize-inheritance ((class std-class)) @@ -979,8 +977,7 @@ ;;; ;;; *** This needs work to make type testing by the writer functions which ;;; *** do type testing faster. The idea would be to have one constructor -;;; *** for each possible type test. In order to do this it would be nice -;;; *** to have help from inform-type-system-about-class and friends. +;;; *** for each possible type test. ;;; ;;; *** There is a subtle bug here which is going to have to be fixed. ;;; *** Namely, the simplistic use of the template has to be fixed. We @@ -996,20 +993,6 @@ (defmethod make-boundp-method-function ((class slot-class) slot-name) (make-std-boundp-method-function (class-name class) slot-name)) -;;;; inform-type-system-about-class -;;; -;;; These are NOT part of the standard protocol. They are internal -;;; mechanism which PCL uses to *try* and tell the type system about -;;; class definitions. In a more fully integrated implementation of -;;; CLOS, the type system would know about class objects and class -;;; names in a more fundamental way and the mechanism used to inform -;;; the type system about new classes would be different. -(defmethod inform-type-system-about-class ((class std-class) name) - (inform-type-system-about-std-class name)) - -(defmethod inform-type-system-about-class ((class structure-class) (name t)) - nil) - (defmethod compatible-meta-class-change-p (class proto-new-class) (eq (class-of class) (class-of proto-new-class))) diff --git a/src/pcl/walk.lisp b/src/pcl/walk.lisp index 6078fb6..db24948 100644 --- a/src/pcl/walk.lisp +++ b/src/pcl/walk.lisp @@ -632,7 +632,7 @@ (defun walk-unexpected-declare (form context env) (declare (ignore context env)) - (warn "encountered DECLARE ~S in a place where a DECLARE was not expected" + (warn "encountered ~S ~_in a place where a DECLARE was not expected" form) form) diff --git a/tests/run-program.test.sh b/tests/run-program.test.sh index 133198e..9f7b9ab 100644 --- a/tests/run-program.test.sh +++ b/tests/run-program.test.sh @@ -57,16 +57,5 @@ if [ $? != 52 ]; then exit 1 fi -# known bugs: -# -# sbcl-0.6.8: -# -# (SB-EXT:RUN-PROGRAM "echo" NIL) -# => error in function SB-IMPL::%ENUMERATE-SEARCH-LIST: -# Undefined search list: path -# -# (SB-EXT:RUN-PROGRAM "/bin/uname" '("-a") :OUTPUT :STREAM) -# doesn't return a STREAM (the way doc string claims) - # success convention exit 104 diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp index 4ce0363..3b6a76b 100644 --- a/tests/type.impure.lisp +++ b/tests/type.impure.lisp @@ -196,14 +196,17 @@ (assert (eq (car (sb-pcl:class-direct-superclasses (sb-pcl:find-class 'simple-condition))) (sb-pcl:find-class 'condition))) - (assert (null (set-difference - (sb-pcl:class-direct-subclasses (sb-pcl:find-class - 'simple-condition)) - (mapcar #'sb-pcl:find-class - '(simple-type-error - simple-error - sb-int:simple-file-error - sb-int:simple-style-warning))))) + + (let ((subclasses (mapcar #'sb-pcl:find-class + '(simple-type-error + simple-error + simple-warning + sb-int:simple-file-error + sb-int:simple-style-warning)))) + (assert (null (set-difference + (sb-pcl:class-direct-subclasses (sb-pcl:find-class + 'simple-condition)) + subclasses)))) ;; precedence lists (assert (equal (sb-pcl:class-precedence-list diff --git a/version.lisp-expr b/version.lisp-expr index 644e2f8..e756140 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.17" +"0.7.1.19"