For some more details see comments for (define-alien-type-method
(c-string :deport-gen) ...) in host-c-call.lisp.
-402: "DECLAIM DECLARATION does not inform the PCL code-walker"
- reported by Vincent Arkesteijn:
-
- (declaim (declaration foo))
- (defgeneric bar (x))
- (defmethod bar (x)
- (declare (foo x))
- x)
-
- ==> WARNING: The declaration FOO is not understood by
- SB-PCL::SPLIT-DECLARATIONS.
- Please put FOO on one of the lists SB-PCL::*NON-VAR-DECLARATIONS*,
- SB-PCL::*VAR-DECLARATIONS-WITH-ARG*, or
- SB-PCL::*VAR-DECLARATIONS-WITHOUT-ARG*.
- (Assuming it is a variable declaration without argument).
-
403: FORMAT/PPRINT-LOGICAL-BLOCK of CONDITIONs ignoring *PRINT-CIRCLE*
In sbcl-0.9.13.34,
(defparameter *c*
implementation of read circularity, using a symbol as a marker for
the previously-referenced object.
-413: type-errors in ROOM
-
- (defvar *a* (make-array (expt 2 27)))
- (room)
-
- Causes a type-error on 32bit SBCL, as various byte-counts in ROOM
- implementation overrun fixnums.
-
- This was fixed in 1.0.4.89, but the patch was reverted as it caused
- ROOM to cons sufficiently to make running it in a loop deadly on
- GENCGC: newly allocated objects survived to generation 1, where next
- call to ROOM would see them, and allocate even more...
-
- Reported by Faré Rideau on sbcl-devel.
-
415: Issues creating large arrays on x86-64/Linux and x86/Darwin
(make-array (1- array-dimension-limit))
* new feature: SB-EXT:*EXIT-HOOKS* are called when the process exits
(see documentation for details.)
* revived support for OpenBSD (contributed by Josh Elsasser)
+ * partially fixed bug #108: ROOM no longer suffers from occasional
+ (AVER (SAP= CURRENT END)) failures .
+ * fixed bug #402: proclaimed non-standard declarations in DEFMETHOD
+ bodies no longer cause a WARNING to be signalled. (reported by
+ Vincent Arkesteijn)
* bug fix: (TRUNCATE X 0) when X is a bignum now correctly signals
DIVISION-BY-ZERO. Similarly for MOD and REM (which suffered due to
the bug in TRUNCATE.) (reported by Michael Weber)
no samples. (reported by Andy Hefner)
* bug fix: functions compiled using (COMPILE NIL '(LAMBDA ...))
no longer appear as (NIL ...) frames in backtraces.
- * bug fix: ROOM no longer suffers from occasional (AVER (SAP=
- CURRENT END)) failures.
* bug fix: RESOLVE-CONFLICT (and the other name conflict machinery)
is now actually exported from SB-EXT as documented. (reported by
Maciej Katafiasz)
(push (list class-name symbol) *built-in-wrapper-symbols*)
symbol)))
\f
-(pushnew '%class *var-declarations*)
-(pushnew '%variable-rebinding *var-declarations*)
-
-(defun variable-class (var env)
- (caddr (var-declaration 'class var env)))
-
(defvar *standard-method-combination*)
\f
(defun plist-value (object name)
(declare ,(make-pv-type-declaration '.pv.))
,@forms)))
-(defvar *non-var-declarations*
- ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but I
- ;; don't *think* CMU CL had, or SBCL has, VALUES declarations. If
- ;; SBCL doesn't have 'em, VALUES should probably be removed from
- ;; this list.
- '(values
- %method-name
- %method-lambda-list
- optimize
- ftype
- muffle-conditions
- inline
- notinline))
-
-(defvar *var-declarations-with-arg*
- '(%class
- type))
-
-(defvar *var-declarations-without-arg*
- '(ignore
- ignorable special dynamic-extent
- ;; FIXME: Possibly this entire list and variable could go away.
- ;; If not, certainly we should remove all these built-in typenames
- ;; from the list, and replace them with a test for "is it a type
- ;; name?" (CLTL1 allowed only built-in type names as declarations,
- ;; but ANSI CL allows any type name as a declaration.)
- array atom base-char bignum bit bit-vector character compiled-function
- complex cons double-float extended-char
- fixnum float function hash-table integer
- keyword list long-float nil null number package pathname random-state ratio
- rational readtable sequence short-float signed-byte simple-array
- simple-bit-vector simple-string simple-vector single-float standard-char
- stream string symbol t unsigned-byte vector))
-
(defun split-declarations (body args maybe-reads-params-p)
(let ((inner-decls nil)
(outer-decls nil)
decl)
- (loop (when (null body) (return nil))
- (setq decl (car body))
- (unless (and (consp decl)
- (eq (car decl) 'declare))
- (return nil))
- (dolist (form (cdr decl))
- (when (consp form)
- (let ((declaration-name (car form)))
- (if (member declaration-name *non-var-declarations*)
- (push `(declare ,form) outer-decls)
- (let ((arg-p
- (member declaration-name
- *var-declarations-with-arg*))
- (non-arg-p
- (member declaration-name
- *var-declarations-without-arg*))
- (dname (list (pop form)))
- (inners nil) (outers nil))
- (unless (or arg-p non-arg-p)
- ;; FIXME: This warning, and perhaps the
- ;; various *VAR-DECLARATIONS-FOO* and/or
- ;; *NON-VAR-DECLARATIONS* variables,
- ;; could probably go away now that we're not
- ;; trying to be portable between different
- ;; CLTL1 hosts the way PCL was. (Note that to
- ;; do this right, we need to be able to handle
- ;; user-defined (DECLAIM (DECLARATION FOO))
- ;; stuff.)
- (warn "The declaration ~S is not understood by ~S.~@
- Please put ~S on one of the lists ~S,~%~S, or~%~S.~@
- (Assuming it is a variable declaration without argument)."
- declaration-name 'split-declarations
- declaration-name
- '*non-var-declarations*
- '*var-declarations-with-arg*
- '*var-declarations-without-arg*)
- (push declaration-name *var-declarations-without-arg*))
- (when arg-p
- (setq dname (append dname (list (pop form)))))
- (case (car dname)
- (%class (push `(declare (,@dname ,@form)) inner-decls))
- (t
- (dolist (var form)
- (if (member var args)
- ;; Quietly remove IGNORE declarations
- ;; on args when a next-method is
- ;; involved, to prevent compiler
- ;; warnings about ignored args being
- ;; read.
- (unless (and maybe-reads-params-p
- (eq (car dname) 'ignore))
- (push var outers))
- (push var inners)))
- (when outers
- (push `(declare (,@dname ,@outers)) outer-decls))
- (when inners
- (push
- `(declare (,@dname ,@inners))
- inner-decls)))))))))
- (setq body (cdr body)))
+ (loop
+ (when (null body)
+ (return nil))
+ (setq decl (car body))
+ (unless (and (consp decl) (eq (car decl) 'declare))
+ (return nil))
+ (dolist (form (cdr decl))
+ (when (consp form)
+ (let* ((name (car form)))
+ (cond ((eq '%class name)
+ (push `(declare ,form) inner-decls))
+ ((or (member name '(ignore ignorable special dynamic-extent type))
+ (info :type :kind name))
+ (let* ((inners nil)
+ (outers nil)
+ (tail (cdr form))
+ (head (if (eq 'type name)
+ (list name (pop tail))
+ (list name))))
+ (dolist (var tail)
+ (if (member var args)
+ ;; Quietly remove IGNORE declarations on
+ ;; args when a next-method is involved, to
+ ;; prevent compiler warnings about ignored
+ ;; args being read.
+ (unless (and (eq 'ignore name) maybe-reads-params-p)
+ (push var outers))
+ (push var inners)))
+ (when outers
+ (push `(declare (,@head ,@outers)) outer-decls))
+ (when inners
+ (push `(declare (,@head ,@inners)) inner-decls))))
+ (t
+ ;; All other declarations are not variable declarations,
+ ;; so they become outer declarations.
+ (push `(declare ,form) outer-decls))))))
+ (setq body (cdr body)))
(values outer-decls inner-decls body)))
;;; Pull a name out of the %METHOD-NAME declaration in the function
(when (eq (cadar entry) 'sb!sys:macro)
entry)))
-(defvar *var-declarations* '(special))
+(defun walked-var-declaration-p (declaration)
+ (member declaration '(sb!pcl::%class sb!pcl::%variable-rebinding special)))
+
+(defun %var-declaration (declaration var env)
+ (let ((id (or (var-lexical-p var env) var)))
+ (dolist (decl (env-declarations env))
+ (when (and (eq (car decl) declaration)
+ (eq (cadr decl) id))
+ (return decl)))))
(defun var-declaration (declaration var env)
- (if (not (member declaration *var-declarations*))
- (error "~S is not a recognized variable declaration." declaration)
- (let ((id (or (var-lexical-p var env) var)))
- (dolist (decl (env-declarations env))
- (when (and (eq (car decl) declaration)
- (eq (cadr decl) id))
- (return decl))))))
+ (if (walked-var-declaration-p declaration)
+ (%var-declaration declaration var env)
+ (error "Not a variable declaration the walker cares about: ~S" declaration)))
+
+#-sb-xc-host
+(define-compiler-macro var-declaration (&whole form declaration var env
+ &environment lexenv)
+ (if (sb!xc:constantp declaration lexenv)
+ (let ((decl (constant-form-value declaration lexenv)))
+ (if (walked-var-declaration-p decl)
+ `(%var-declaration ,declaration ,var ,env)
+ form))
+ form))
(defun var-special-p (var env)
- (or (not (null (var-declaration 'special var env)))
- (var-globally-special-p var)))
+ (and (or (var-declaration 'special var env)
+ (var-globally-special-p var))
+ t))
(defun var-globally-special-p (symbol)
(eq (info :variable :kind symbol) :special))
(let ((type (car declaration))
(name (cadr declaration))
(args (cddr declaration)))
- (if (member type *var-declarations*)
+ (if (walked-var-declaration-p type)
(note-declaration `(,type
,(or (var-lexical-p name env) name)
,.args)
;;; compiling and disassembling this used to give
;;;
-;;; WARNING: bogus form-number in form! The source file has probably
+;;; WARNING: bogus form-number in form! The source file has probably
;;; been changed too much to cope with.
;;;
;;; but the symptoms have disappeared.
(assert (not (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'warning))))
(assert (not (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'hash-table))))
(assert (eq t (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'standard-object))))
+
+;;;; bug 402: PCL used to warn about non-standard declarations
+(declaim (declaration bug-402-d))
+(defgeneric bug-402-gf (x))
+(with-test (:name :bug-402)
+ (handler-bind ((warning #'error))
+ (eval '(defmethod bug-402-gf (x)
+ (declare (bug-402-d x))
+ x))))
+
\f
;;;; success
;;; 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".)
-"1.0.13.45"
+"1.0.13.46"
projects / sbcl.git / commitdiff