to Bruno Haible)
changes in sbcl-0.8.11 relative to sbcl-0.8.10:
+ * minor incompatible change: the sb-grovel contrib now treats C
+ structures as alien (in the sense of SB-ALIEN) objects rather than
+ as undistinguished (simple-array (unsigned-byte 8) (*))s. This
+ has implications for memory management of client code
+ (sb-grovel-returned objects must now be manually managed) and for
+ type safety (alien objects now have full types).
* new feature: the SB-EXT:MUFFLE-CONDITIONS declaration should be
used to control emission of compiler diagnostics, rather than the
SB-EXT:INHIBIT-WARNINGS OPTIMIZE quality. See the manual for
documentation on this feature. The SB-EXT:INHIBIT-WARNINGS
quality should be considered deprecated.
+ * (not quite a new documentable feature, but worth considering in
+ the light of the new SB-EXT:MUFFLE-CONDITIONS declaration): the
+ beginnings of a semantically meaningful condition hierarchy is
+ under development, for use in SB-EXT:MUFFLE-CONDITIONS and by
+ IDEs.
* fixed bug: DEFCLASS slot definitions with identical :READER and
:WRITER names now signal a reasonable error. (reported by Thomas
Burdick)
* Make the system sources understandable to the system, so that
searching for sources doesn't error out quite so often
(e.g. in error handlers)
- ** provided a location-independent way of referring to source
- files in the target image, maybe a SYS: logical
- pathname, and made the build system respect this.
** provided a suitable readtable for reading in the source
files when necessary, and a mechanism for activating
this readtable rather than the standard one.
+* Some work on conditions emitted by the system
+ ** eliminated COMPILER-WARN and COMPILER-STYLE-WARN, which
+ were simply limited versions of WARN and STYLE-WARN.
+ ** eliminated use of INHIBIT-WARNINGS by code emitted by the
+ system from user code.
+ ** caused use of INHIBIT-WARNINGS to signal a STYLE-WARNING.
+ ** eliminated use of INHIBIT-WARNINGS within the system
+ ** deprecated INHIBIT-WARNINGS, causing its use to signal a
+ full WARNING.
+ ** began work on developing a class hierarchy of conditions
+ along semantic lines.
+ ** annotated conditions emitted by the system to have
+ references to documentation where applicable, so that
+ users can easily find an explanation for the
+ conditions they're seeing.
=======================================================================
for 0.9:
;; ..and CONDITIONs..
"BUG"
"UNSUPPORTED-OPERATOR"
+ "REFERENCE-CONDITION" "REFERENCE-CONDITION-REFERENCES"
+ "*PRINT-CONDITION-REFERENCES*"
+ "DUPLICATE-DEFINITION" "DUPLICATE-DEFINITION-NAME"
+ "PACKAGE-AT-VARIANCE" "ARRAY-INITIAL-ELEMENT-MISMATCH"
+ "TYPE-WARNING" "LOCAL-ARGUMENT-MISMATCH"
+
;; ..and DEFTYPEs..
"INDEX" "LOAD/STORE-INDEX"
"SIGNED-BYTE-WITH-A-BITE-OUT"
(reader-error-format-arguments condition)
(reader-impossible-number-error-error condition))))))
-(define-condition sb!ext::timeout (serious-condition) ())
-
-(define-condition defconstant-uneql (error)
- ((name :initarg :name :reader defconstant-uneql-name)
- (old-value :initarg :old-value :reader defconstant-uneql-old-value)
- (new-value :initarg :new-value :reader defconstant-uneql-new-value))
- (:report
- (lambda (condition stream)
- (format stream
- "~@<The constant ~S is being redefined (from ~S to ~S)~@:>"
- (defconstant-uneql-name condition)
- (defconstant-uneql-old-value condition)
- (defconstant-uneql-new-value condition)))))
+(define-condition timeout (serious-condition) ())
\f
;;;; special SBCL extension conditions
"unsupported on this platform (OS, CPU, whatever): ~S"
(cell-error-name condition)))))
\f
+;;; (:ansi-cl :function remove)
+;;; (:ansi-cl :section (a b c))
+;;; (:ansi-cl :glossary "similar")
+;;;
+;;; (:sbcl :node "...")
+;;;
+;;; FIXME: this is not the right place for this.
+(defun print-reference (reference stream)
+ (ecase (car reference)
+ (:ansi-cl
+ (format stream "The ANSI Standard")
+ (format stream ", ")
+ (destructuring-bind (type data) (cdr reference)
+ (ecase type
+ (:function (format stream "Function ~S" data))
+ (:special-operator (format stream "Special Operator ~S" data))
+ (:macro (format stream "Macro ~S" data))
+ (:section (format stream "Section ~{~D~^.~}" data))
+ (:glossary (format stream "Glossary Entry ~S" data)))))
+ (:sbcl
+ (format stream "The SBCL Manual")
+ (format stream ", ")
+ (destructuring-bind (type data) (cdr reference)
+ (ecase type
+ (:node (format stream "Node ~S" data)))))
+ ;; FIXME: other documents (e.g. AMOP, Franz documentation :-)
+ ))
+(define-condition reference-condition ()
+ ((references :initarg :references :reader reference-condition-references)))
+(defvar *print-condition-references* t)
+(def!method print-object :around ((o reference-condition) s)
+ (call-next-method)
+ (unless (or *print-escape* *print-readably*)
+ (when *print-condition-references*
+ (format s "~&See also:~%")
+ (pprint-logical-block (s nil :per-line-prefix " ")
+ (do* ((rs (reference-condition-references o) (cdr rs))
+ (r (car rs) (car rs)))
+ ((null rs))
+ (print-reference r s)
+ (unless (null (cdr rs))
+ (terpri s)))))))
+
+(define-condition duplicate-definition (reference-condition warning)
+ ((name :initarg :name :reader duplicate-definition-name))
+ (:report (lambda (c s)
+ (format s "~@<Duplicate definition for ~S found in ~
+ one file.~@:>"
+ (duplicate-definition-name c))))
+ (:default-initargs :references (list '(:ansi-cl :section (3 2 2 3)))))
+
+(define-condition package-at-variance (reference-condition simple-warning)
+ ()
+ (:default-initargs :references (list '(:ansi-cl :macro defpackage))))
+
+(define-condition defconstant-uneql (reference-condition error)
+ ((name :initarg :name :reader defconstant-uneql-name)
+ (old-value :initarg :old-value :reader defconstant-uneql-old-value)
+ (new-value :initarg :new-value :reader defconstant-uneql-new-value))
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "~@<The constant ~S is being redefined (from ~S to ~S)~@:>"
+ (defconstant-uneql-name condition)
+ (defconstant-uneql-old-value condition)
+ (defconstant-uneql-new-value condition))))
+ (:default-initargs :references (list '(:ansi-cl :macro defconstant)
+ '(:sbcl :node "Idiosyncrasies"))))
+
+(define-condition array-initial-element-mismatch
+ (reference-condition simple-warning)
+ ()
+ (:default-initargs
+ :references (list '(:ansi-cl :function make-array)
+ '(:ansi-cl :function upgraded-array-element-type))))
+
+(define-condition type-warning (reference-condition simple-warning)
+ ()
+ (:default-initargs :references (list '(:sbcl :node "Handling of Types"))))
+
+(define-condition local-argument-mismatch (reference-condition simple-warning)
+ ()
+ (:default-initargs :references (list '(:ansi-cl :section (3 2 2 3)))))
+\f
;;;; restart definitions
(define-condition abort-failure (control-error) ()
(shadowing-import sym package)
(setf old-shadows (remove sym old-shadows))))))
(when old-shadows
- (warn "~A also shadows the following symbols:~% ~S"
- name old-shadows)))
+ (warn 'package-at-variance
+ :format-control "~A also shadows the following symbols:~% ~S"
+ :format-arguments (list name old-shadows))))
;; Handle USE.
(unless (eq use :default)
(let ((old-use-list (package-use-list package))
(let ((laterize (set-difference old-use-list new-use-list)))
(when laterize
(unuse-package laterize package)
- (warn "~A used to use the following packages:~% ~S"
- name
- laterize)))))
+ (warn 'package-at-variance
+ :format-control "~A used to use the following packages:~% ~S"
+ :format-arguments (list name laterize))))))
;; Handle IMPORT and INTERN.
(dolist (sym-name interns)
(intern sym-name package))
(export exports package)
(let ((diff (set-difference old-exports exports)))
(when diff
- (warn "~A also exports the following symbols:~% ~S" name diff))))
+ (warn 'package-at-variance
+ :format-control "~A also exports the following symbols:~% ~S"
+ :format-arguments (list name diff)))))
;; Handle documentation.
(setf (package-doc-string package) doc-string)
package))
((not (ctypep value (sb!vm:saetp-ctype saetp)))
;; this case will cause an error at runtime, so we'd
;; better WARN about it now.
- (compiler-warn "~@<~S is not a ~S (which is the ~
- UPGRADED-ARRAY-ELEMENT-TYPE of ~S).~@:>"
- value
- (type-specifier (sb!vm:saetp-ctype saetp))
- eltype))
+ (warn 'array-initial-element-mismatch
+ :format-control "~@<~S is not a ~S (which is the ~
+ ~S of ~S).~@:>"
+ :format-arguments
+ (list
+ value
+ (type-specifier (sb!vm:saetp-ctype saetp))
+ 'upgraded-array-element-type
+ eltype)))
((not (ctypep value eltype-type))
;; this case will not cause an error at runtime, but
;; it's still worth STYLE-WARNing about.
(leaf-source-name (elt (lambda-vars lambda)
pos)))))))
(cond ((and (ref-p use) (constant-p (ref-leaf use)))
- (compiler-warn "~:[This~;~:*~A~] is not a ~<~%~9T~:;~S:~>~% ~S"
- what atype-spec (constant-value (ref-leaf use))))
+ (warn 'type-warning
+ :format-control
+ "~:[This~;~:*~A~] is not a ~<~%~9T~:;~S:~>~% ~S"
+ :format-arguments
+ (list what atype-spec
+ (constant-value (ref-leaf use)))))
(t
- (compiler-warn
- "~:[Result~;~:*~A~] is a ~S, ~<~%~9T~:;not a ~S.~>"
- what (type-specifier dtype) atype-spec))))))))
+ (warn 'type-warning
+ :format-control
+ "~:[Result~;~:*~A~] is a ~S, ~<~%~9T~:;not a ~S.~>"
+ :format-arguments
+ (list what (type-specifier dtype) atype-spec)))))))))
(values))
;;; Loop over all blocks in COMPONENT that have TYPE-CHECK set,
(let ((atype (lvar-value atype))
(dtype (lvar-value dtype)))
(unless (eq atype nil)
- (compiler-warn
- "~@<Asserted type ~S conflicts with derived type ~S.~@:>"
- atype dtype))))
+ (warn 'type-warning
+ :format-control
+ "~@<Asserted type ~S conflicts with derived type ~S.~@:>"
+ :format-arguments (list atype dtype)))))
(ir2-convert-full-call node block)))
(:aborted
(setf (combination-kind node) :error)
(when args
- (apply #'compiler-warn args))
+ (apply #'warn args))
(remhash node table)
nil)
(:failure
(style-warning 'style-warning)
(warning 'warning)
((or error compiler-error) 'error))))
- (multiple-value-bind (format-string format-args)
- (if (typep condition 'simple-condition)
- (values (simple-condition-format-control condition)
- (simple-condition-format-arguments condition))
- (values "~A"
- (list (with-output-to-string (s)
- (princ condition s)))))
- (print-compiler-message
- (format nil "caught ~S:~% ~A" what format-string)
- format-args)))
+ (print-compiler-message
+ (format nil "caught ~S:~%~~@< ~~@;~~A~~:>" what)
+ (list (with-output-to-string (s) (princ condition s)))))
(values))
;;; The act of signalling one of these beasts must not cause WARNINGSP
(muffle-warning ()
(return-from compiler-notify (values))))
(incf *compiler-note-count*)
- (multiple-value-bind (format-string format-args)
- (if (typep condition 'simple-condition)
- (values (simple-condition-format-control condition)
- (simple-condition-format-arguments condition))
- (values "~A"
- (list (with-output-to-string (s)
- (princ condition s)))))
- (print-compiler-message (format nil "note: ~A" format-string)
- format-args))))
+ (print-compiler-message
+ (format nil "note: ~~A")
+ (list (with-output-to-string (s) (princ condition s))))))
(values))
;;; Issue a note when we might or might not be in the compiler.
(aver (fasl-output-p *compile-object*))
(if (member name *fun-names-in-this-file* :test #'equal)
- (compiler-warn "~@<Duplicate definition for ~S found in ~
- one static unit (usually a file).~@:>"
- name)
+ (warn 'duplicate-definition :name name)
(push name *fun-names-in-this-file*)))
(become-defined-fun-name name)
;; there's no need for us to accept ANSI's lameness when
;; processing our own code, though.
#+sb-xc-host
- (compiler-warn "reading an ignored variable: ~S" name)))
+ (warn "reading an ignored variable: ~S" name)))
(reference-leaf start next result var))
(cons
(aver (eq (car var) 'MACRO))
(muffle-warning-or-die)))
#-(and cmu sb-xc-host)
(warning (lambda (c)
- (compiler-warn "~@<~A~:@_~A~@:_~A~:>"
- (wherestring) hint c)
+ (warn "~@<~A~:@_~A~@:_~A~:>"
+ (wherestring) hint c)
(muffle-warning-or-die)))
(error (lambda (c)
(compiler-error "~@<~A~:@_~A~@:_~A~:>"
(find-free-var var-name))))
(etypecase var
(leaf
- (flet ((process-var (var bound-var)
- (let* ((old-type (or (lexenv-find var type-restrictions)
- (leaf-type var)))
- (int (if (or (fun-type-p type)
- (fun-type-p old-type))
- type
- (type-approx-intersection2 old-type type))))
- (cond ((eq int *empty-type*)
- (unless (policy *lexenv* (= inhibit-warnings 3))
- (compiler-warn
- "The type declarations ~S and ~S for ~S conflict."
- (type-specifier old-type) (type-specifier type)
- var-name)))
- (bound-var (setf (leaf-type bound-var) int))
- (t
- (restr (cons var int)))))))
+ (flet
+ ((process-var (var bound-var)
+ (let* ((old-type (or (lexenv-find var type-restrictions)
+ (leaf-type var)))
+ (int (if (or (fun-type-p type)
+ (fun-type-p old-type))
+ type
+ (type-approx-intersection2
+ old-type type))))
+ (cond ((eq int *empty-type*)
+ (unless (policy *lexenv* (= inhibit-warnings 3))
+ (warn
+ 'type-warning
+ :format-control
+ "The type declarations ~S and ~S for ~S conflict."
+ :format-arguments
+ (list
+ (type-specifier old-type)
+ (type-specifier type)
+ var-name))))
+ (bound-var (setf (leaf-type bound-var) int))
+ (t
+ (restr (cons var int)))))))
(process-var var bound-var)
(awhen (and (lambda-var-p var)
(lambda-var-specvar var))
;; There's no reason to accept this kind of equivocation
;; when compiling our own code, though.
#+sb-xc-host
- (compiler-warn "The variable ~S is defined but never used."
- (leaf-debug-name var)))
+ (warn "The variable ~S is defined but never used."
+ (leaf-debug-name var)))
(setf (leaf-ever-used var) t)))) ; to avoid repeated warnings? -- WHN
(values))
(cond ((= n-call-args nargs)
(convert-call ref call fun))
(t
- ;; FIXME: ANSI requires in "3.2.5 Exceptional Situations in the
- ;; Compiler" that calling a function with "the wrong number of
- ;; arguments" be only a STYLE-ERROR. I think, though, that this
- ;; should only apply when the number of arguments is inferred
- ;; from a previous definition. If the number of arguments
- ;; is DECLAIMed, surely calling with the wrong number is a
- ;; real WARNING. As long as SBCL continues to use CMU CL's
- ;; non-ANSI DEFUN-is-a-DECLAIM policy, we're in violation here,
- ;; but as long as we continue to use that policy, that's the
- ;; not our biggest problem.:-| When we fix that policy, this
- ;; should come back into compliance. (So fix that policy!)
- ;; ..but..
- ;; FIXME, continued: Except that section "3.2.2.3 Semantic
- ;; Constraints" says that if it's within the same file, it's
- ;; wrong. And we're in locall.lisp here, so it's probably
- ;; (haven't checked this..) a call to something in the same
- ;; file. So maybe it deserves a full warning anyway.
- (compiler-warn
+ (warn
+ 'local-argument-mismatch
+ :format-control
"function called with ~R argument~:P, but wants exactly ~R"
- n-call-args nargs)
+ :format-arguments (list n-call-args nargs))
(setf (basic-combination-kind call) :error)))))
\f
;;;; &OPTIONAL, &MORE and &KEYWORD calls
(max-args (optional-dispatch-max-args fun))
(call-args (length (combination-args call))))
(cond ((< call-args min-args)
- ;; FIXME: See FIXME note at the previous
- ;; wrong-number-of-arguments warnings in this file.
- (compiler-warn
+ (warn
+ 'local-argument-mismatch
+ :format-control
"function called with ~R argument~:P, but wants at least ~R"
- call-args min-args)
+ :format-arguments (list call-args min-args))
(setf (basic-combination-kind call) :error))
((<= call-args max-args)
(convert-call ref call
((optional-dispatch-more-entry fun)
(convert-more-call ref call fun))
(t
- ;; FIXME: See FIXME note at the previous
- ;; wrong-number-of-arguments warnings in this file.
- (compiler-warn
+ (warn
+ 'local-argument-mismatch
+ :format-control
"function called with ~R argument~:P, but wants at most ~R"
- call-args max-args)
+ :format-arguments
+ (list call-args max-args))
(setf (basic-combination-kind call) :error))))
(values))
(assert (eq (car (sb-pcl:class-direct-superclasses
(find-class 'simple-condition)))
(find-class 'condition)))
-
- (let ((subclasses (mapcar #'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 (find-class
- 'simple-condition))
- subclasses))))
-
+
+ #+nil ; doesn't look like a good test
+ (let ((subclasses (mapcar #'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 (find-class
+ 'simple-condition))
+ subclasses))))
+
;; precedence lists
- (assert (equal (sb-pcl:class-precedence-list
- (find-class 'simple-condition))
- (mapcar #'find-class '(simple-condition
- condition
- sb-pcl::slot-object
+ (assert (equal (sb-pcl:class-precedence-list
+ (find-class 'simple-condition))
+ (mapcar #'find-class '(simple-condition
+ condition
+ sb-pcl::slot-object
sb-kernel:instance
t))))
;;; 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.10.56"
+"0.8.10.57"
projects / sbcl.git / commitdiff