X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=1e5c7c7bb3bb57934e74dd59bff0619401ae879c;hb=c33612272b00979a34861d962f5e7bd47f36ae6e;hp=6276aa880bc8286604953a86e3a717db36cbaebb;hpb=7cec182a00d4143dc7cfd43fc55c6691e356e609;p=sbcl.git diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 6276aa8..1e5c7c7 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. @@ -499,10 +497,6 @@ (t (error "unknown option: ~S" (first option))))) - (when (all-writers) - (warn "Condition slot setters probably not allowed in ANSI CL:~% ~S" - (all-writers))) - `(progn (eval-when (:compile-toplevel :load-toplevel :execute) (%compiler-define-condition ',name ',parent-types ',layout)) @@ -588,15 +582,7 @@ ((pathname :reader file-error-pathname :initarg :pathname)) (:report (lambda (condition stream) - (format stream - "~@" - (file-error-pathname condition) - ;; FIXME: ANSI's FILE-ERROR doesn't have FORMAT-CONTROL and - ;; FORMAT-ARGUMENTS, and the inheritance here doesn't seem - ;; to give us FORMAT-CONTROL or FORMAT-ARGUMENTS either. - ;; So how does this work? - (serious-condition-format-control condition) - (serious-condition-format-arguments condition))))) + (format stream "error on file ~S" (file-error-pathname condition))))) (define-condition package-error (error) ((package :reader package-error-package :initarg :package))) @@ -703,6 +689,16 @@ "The index ~S is too large." (type-error-datum condition))))) +;;; Out-of-range &KEY END arguments are similar to, but off by one +;;; from out-of-range indices into the sequence. +(define-condition index-too-large-error (type-error) + () + (:report + (lambda (condition stream) + (format stream + "The end-of-sequence specifier ~S is too large." + (type-error-datum condition))))) + (define-condition io-timeout (stream-error) ((direction :reader io-timeout-direction :initarg :direction)) (:report @@ -739,34 +735,79 @@ "unexpected end of file on ~S ~A" (stream-error-stream condition) (reader-eof-error-context condition))))) + +(define-condition reader-impossible-number-error (reader-error) + ((error :reader reader-impossible-number-error-error :initarg :error)) + (:report + (lambda (condition stream) + (let ((error-stream (stream-error-stream condition))) + (format stream "READER-ERROR ~@[at ~W ~]on ~S:~%~?~%Original error: ~A" + (file-position error-stream) error-stream + (reader-error-format-control condition) + (reader-error-format-arguments condition) + (reader-impossible-number-error-error condition)))))) ;;;; special SBCL extension conditions -;;; a condition for use in stubs for operations which aren't -;;; unsupported on some OSes/CPUs/whatever +;;; an error apparently caused by a bug in SBCL itself +;;; +;;; Note that we don't make any serious effort to use this condition +;;; for *all* errors in SBCL itself. E.g. type errors and array +;;; indexing errors can occur in functions called from SBCL code, and +;;; will just end up as ordinary TYPE-ERROR or invalid index error, +;;; because the signalling code has no good way to know that the +;;; underlying problem is a bug in SBCL. But in the fairly common case +;;; that the signalling code does know that it's found a bug in SBCL, +;;; this condition is appropriate, reusing boilerplate and helping +;;; users to recognize it as an SBCL bug. +(define-condition bug (simple-error) + () + (:report + (lambda (condition stream) + (format stream + "~@< ~? ~:@_~?~:>" + (simple-condition-format-control condition) + (simple-condition-format-arguments condition) + "~@.~:@>" + '((fmakunbound 'compile)))))) +(defun bug (format-control &rest format-arguments) + (error 'bug + :format-control format-control + :format-arguments format-arguments)) + +;;; a condition for use in stubs for operations which aren't supported +;;; on some platforms ;;; -;;; E.g. in sbcl-0.7.0.5, it might be appropriate to do something -;;; like +;;; E.g. in sbcl-0.7.0.5, it might be appropriate to do something like ;;; #-(or freebsd linux) ;;; (defun load-foreign (&rest rest) ;;; (error 'unsupported-operator :name 'load-foreign)) ;;; #+(or freebsd linux) ;;; (defun load-foreign ... actual definition ...) ;;; By signalling a standard condition in this case, we make it -;;; possible for test code to distinguish between intentionally not -;;; implemented and just screwed up somehow. (Before this condition -;;; was defined, this was dealt with by checking for FBOUNDP, but -;;; that didn't work reliably. In sbcl-0.7.0, a a package screwup -;;; left the definition of LOAD-FOREIGN in the wrong package, so -;;; it was unFBOUNDP even on architectures where it was supposed to -;;; be supported, and the regression tests cheerfully passed because -;;; they assumed that unFBOUNDPness meant they were running on an -;;; system which didn't support the extension.) +;;; possible for test code to distinguish between (1) intentionally +;;; unimplemented and (2) unintentionally just screwed up somehow. +;;; (Before this condition was defined, test code tried to deal with +;;; this by checking for FBOUNDP, but that didn't work reliably. In +;;; sbcl-0.7.0, a a package screwup left the definition of +;;; LOAD-FOREIGN in the wrong package, so it was unFBOUNDP even on +;;; architectures where it was supposed to be supported, and the +;;; regression tests cheerfully passed because they assumed that +;;; unFBOUNDPness meant they were running on an system which didn't +;;; support the extension.) (define-condition unsupported-operator (cell-error) () (:report (lambda (condition stream) (format stream - "unsupported on this implementation: ~S" + "unsupported on this platform (OS, CPU, whatever): ~S" (cell-error-name condition))))) ;;;; restart definitions