\f
;;;; the CONDITION class
+(/show0 "late-target-error.lisp 20")
+
(eval-when (:compile-toplevel :load-toplevel :execute)
(def!struct (condition-class (:include slot-class)
(defun make-condition-class (&rest rest)
(apply #'bare-make-condition-class
- (rename-keyword-args '((:name :%name)) rest)))
+ (rename-key-args '((:name :%name)) rest)))
) ; EVAL-WHEN
condition-class
make-condition-class)
(:copier nil))
-
- (function-name nil)
;; actual initargs supplied to MAKE-CONDITION
(actual-initargs (required-argument) :type list)
- ;; plist mapping slot names to any values that were assigned or
+ ;; a plist mapping slot names to any values that were assigned or
;; defaulted after creation
(assigned-slots () :type list))
-(defstruct condition-slot
+(defstruct (condition-slot (:copier nil))
(name (required-argument) :type symbol)
;; list of all applicable initargs
(initargs (required-argument) :type list)
(if (eq val *empty-condition-slot*)
(let ((actual-initargs (condition-actual-initargs condition))
(slot (find-condition-class-slot class name)))
- ;; MNA: cmucl-commit: Mon, 8 Jan 2001 21:21:23 -0800 (PST)
- ;; Catch missing slots in condition-reader-function, and signal an error.
(unless slot
- (error "Slot ~S of ~S missing." name condition))
+ (error "missing slot ~S of ~S" name condition))
(dolist (initarg (condition-slot-initargs slot))
(let ((val (getf actual-initargs
initarg
(define-condition style-warning (warning) ())
(defun simple-condition-printer (condition stream)
- (apply #'format stream (simple-condition-format-control condition)
- (simple-condition-format-arguments condition)))
+ (apply #'format
+ stream
+ (simple-condition-format-control condition)
+ (simple-condition-format-arguments condition)))
(define-condition simple-condition ()
((format-control :reader simple-condition-format-control
(define-condition simple-warning (simple-condition warning) ())
-(defun print-simple-error (condition stream)
- (format stream
- "~&~@<error in function ~S: ~3I~:_~?~:>"
- (condition-function-name condition)
- (simple-condition-format-control condition)
- (simple-condition-format-arguments condition)))
-
-(define-condition simple-error (simple-condition error) ()
- ;; This is the condition type used by ERROR and CERROR when
- ;; a format-control string is supplied as the first argument.
- (:report print-simple-error))
+;;; This is the condition type used by ERROR and CERROR when
+;;; a format-control string is supplied as the first argument.
+(define-condition simple-error (simple-condition error) ())
(define-condition storage-condition (serious-condition) ())
-;;; FIXME: Should we really be reporting CONDITION-FUNCTION-NAME data
-;;; on an ad hoc basis, for some conditions and not others? Why not
-;;; standardize it somehow? perhaps by making the debugger report it?
-
(define-condition type-error (error)
((datum :reader type-error-datum :initarg :datum)
(expected-type :reader type-error-expected-type :initarg :expected-type))
(:report
(lambda (condition stream)
(format stream
- "~@<TYPE-ERROR in ~S: ~3I~:_~S is not of type ~S~:>."
- (condition-function-name condition)
+ "~@<The value ~2I~:_~S ~I~_is not of type ~2I~_~S.~:>"
(type-error-datum condition)
(type-error-expected-type condition)))))
(:report
(lambda (condition stream)
(format stream
- "END-OF-FILE on ~S"
+ "end of file on ~S"
(stream-error-stream condition)))))
(define-condition file-error (error)
(:report
(lambda (condition stream)
(format stream
- "~&~@<FILE-ERROR in function ~S: ~3i~:_~?~:>"
- (condition-function-name condition)
+ "~@<error on file ~_~S: ~2I~:_~?~:>"
+ (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)))))
(:report
(lambda (condition stream)
(format stream
- "error in ~S: The variable ~S is unbound."
- (condition-function-name condition)
+ "The variable ~S is unbound."
(cell-error-name condition)))))
(define-condition undefined-function (cell-error) ()
(:report
(lambda (condition stream)
(format stream
- "error in ~S: The function ~S is undefined."
- (condition-function-name condition)
+ "The function ~S is undefined."
(cell-error-name condition)))))
(define-condition arithmetic-error (error)
(format stream "~S cannot be printed readably." obj)))))
(define-condition reader-error (parse-error stream-error)
- ;; FIXME: Do we need FORMAT-CONTROL and FORMAT-ARGUMENTS when
- ;; we have an explicit :REPORT function? I thought we didn't..
((format-control
:reader reader-error-format-control
:initarg :format-control)
(:report
(lambda (condition stream)
(format stream
- "error in ~S: ~S: index too large"
- (condition-function-name condition)
+ "The index ~S is too large."
(type-error-datum condition)))))
(define-condition io-timeout (stream-error)
(lambda (condition stream)
(declare (type stream stream))
(format stream
- "IO-TIMEOUT ~(~A~)ing ~S"
+ "I/O timeout ~(~A~)ing ~S"
(io-timeout-direction condition)
(stream-error-stream condition)))))
(:report
(lambda (condition stream)
(format stream
- "unexpected EOF on ~S ~A"
+ "unexpected end of file on ~S ~A"
(stream-error-stream condition)
(reader-eof-error-context condition)))))
\f
(define-nil-returning-restart use-value (value)
"Transfer control and VALUE to a restart named USE-VALUE, or return NIL if
none exists."))
+
+(/show0 "late-target-error.lisp end of file")
+
projects / sbcl.git / blobdiff