(*print-array* nil))
(format stream "~S cannot be printed readably." obj)))))
-(define-condition reader-error (parse-error stream-error)
- ((format-control
- :reader reader-error-format-control
- :initarg :format-control)
- (format-arguments
- :reader reader-error-format-arguments
- :initarg :format-arguments
- :initform '()))
- (:report
- (lambda (condition stream)
- (let* ((error-stream (stream-error-stream condition))
- (pos (file-position-or-nil-for-error error-stream)))
- (let (lineno colno)
- (when (and pos
- (< pos sb!xc:array-dimension-limit)
- ;; KLUDGE: lseek() (which is what FILE-POSITION
- ;; reduces to on file-streams) is undefined on
- ;; "some devices", which in practice means that it
- ;; can claim to succeed on /dev/stdin on Darwin
- ;; and Solaris. This is obviously bad news,
- ;; because the READ-SEQUENCE below will then
- ;; block, not complete, and the report will never
- ;; be printed. As a workaround, we exclude
- ;; interactive streams from this attempt to report
- ;; positions. -- CSR, 2003-08-21
- (not (interactive-stream-p error-stream))
- (file-position error-stream :start))
- (let ((string
- (make-string pos
- :element-type (stream-element-type
- error-stream))))
- (when (= pos (read-sequence string error-stream))
- (setq lineno (1+ (count #\Newline string))
- colno (- pos
- (or (position #\Newline string :from-end t) -1)
- 1))))
- (file-position-or-nil-for-error error-stream pos))
- (format stream
- "READER-ERROR ~@[at ~W ~]~
- ~@[(line ~W~]~@[, column ~W) ~]~
- on ~S:~%~?"
- pos lineno colno error-stream
- (reader-error-format-control condition)
- (reader-error-format-arguments condition)))))))
+(define-condition reader-error (parse-error stream-error) ()
+ (:report (lambda (condition stream)
+ (%report-reader-error condition stream))))
+
+;;; a READER-ERROR whose REPORTing is controlled by FORMAT-CONTROL and
+;;; FORMAT-ARGS (the usual case for READER-ERRORs signalled from
+;;; within SBCL itself)
+;;;
+;;; (Inheriting CL:SIMPLE-CONDITION here isn't quite consistent with
+;;; the letter of the ANSI spec: this is not a condition signalled by
+;;; SIGNAL when a format-control is supplied by the function's first
+;;; argument. It seems to me (WHN) to be basically in the spirit of
+;;; the spec, but if not, it'd be straightforward to do our own
+;;; DEFINE-CONDITION SB-INT:SIMPLISTIC-CONDITION with
+;;; FORMAT-CONTROL and FORMAT-ARGS slots, and use that condition in
+;;; place of CL:SIMPLE-CONDITION here.)
+(define-condition simple-reader-error (reader-error simple-condition)
+ ()
+ (:report (lambda (condition stream)
+ (%report-reader-error condition stream :simple t))))
+
+;;; base REPORTing of a READER-ERROR
+;;;
+;;; When SIMPLE, we expect and use SIMPLE-CONDITION-ish FORMAT-CONTROL
+;;; and FORMAT-ARGS slots.
+(defun %report-reader-error (condition stream &key simple)
+ (let* ((error-stream (stream-error-stream condition))
+ (pos (file-position-or-nil-for-error error-stream)))
+ (let (lineno colno)
+ (when (and pos
+ (< pos sb!xc:array-dimension-limit)
+ ;; KLUDGE: lseek() (which is what FILE-POSITION
+ ;; reduces to on file-streams) is undefined on
+ ;; "some devices", which in practice means that it
+ ;; can claim to succeed on /dev/stdin on Darwin
+ ;; and Solaris. This is obviously bad news,
+ ;; because the READ-SEQUENCE below will then
+ ;; block, not complete, and the report will never
+ ;; be printed. As a workaround, we exclude
+ ;; interactive streams from this attempt to report
+ ;; positions. -- CSR, 2003-08-21
+ (not (interactive-stream-p error-stream))
+ (file-position error-stream :start))
+ (let ((string
+ (make-string pos
+ :element-type (stream-element-type
+ error-stream))))
+ (when (= pos (read-sequence string error-stream))
+ (setq lineno (1+ (count #\Newline string))
+ colno (- pos
+ (or (position #\Newline string :from-end t) -1)
+ 1))))
+ (file-position-or-nil-for-error error-stream pos))
+ (pprint-logical-block (stream nil)
+ (format stream
+ "~S ~@[at ~W ~]~
+ ~@[(line ~W~]~@[, column ~W) ~]~
+ on ~S"
+ (class-name (class-of condition))
+ pos lineno colno error-stream)
+ (when simple
+ (format stream ":~2I~_~?"
+ (simple-condition-format-control condition)
+ (simple-condition-format-arguments condition)))))))
\f
;;;; special SBCL extension conditions
;;; 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
+;;; sbcl-0.7.0, 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 (simple-error) ())
-
\f
;;; (:ansi-cl :function remove)
;;; (:ansi-cl :section (a b c))
'(:ansi-cl :section (15 1 2 1))
'(:ansi-cl :section (15 1 2 2)))))
-(define-condition io-timeout (stream-error)
- ((direction :reader io-timeout-direction :initarg :direction))
- (:report
- (lambda (condition stream)
- (declare (type stream stream))
- (format stream
- "I/O timeout ~(~A~)ing ~S"
- (io-timeout-direction condition)
- (stream-error-stream condition)))))
-
(define-condition namestring-parse-error (parse-error)
((complaint :reader namestring-parse-error-complaint :initarg :complaint)
(args :reader namestring-parse-error-args :initarg :args :initform nil)
(define-condition simple-package-error (simple-condition package-error) ())
-(define-condition reader-package-error (reader-error) ())
+(define-condition simple-reader-package-error (simple-reader-error) ())
(define-condition reader-eof-error (end-of-file)
((context :reader reader-eof-error-context :initarg :context))
(stream-error-stream condition)
(reader-eof-error-context condition)))))
-(define-condition reader-impossible-number-error (reader-error)
+(define-condition reader-impossible-number-error (simple-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"
+ (format stream
+ "READER-ERROR ~@[at ~W ~]on ~S:~%~?~%Original error: ~A"
(file-position-or-nil-for-error error-stream) error-stream
- (reader-error-format-control condition)
- (reader-error-format-arguments condition)
+ (simple-condition-format-control condition)
+ (simple-condition-format-arguments condition)
(reader-impossible-number-error-error condition))))))
-(define-condition timeout (serious-condition) ())
+(define-condition timeout (serious-condition)
+ ((seconds :initarg :seconds :initform nil :reader timeout-seconds))
+ (:report (lambda (condition stream)
+ (format stream "Timeout occurred~@[ after ~A seconds~]."
+ (timeout-seconds condition)))))
+
+(define-condition io-timeout (stream-error timeout)
+ ((direction :reader io-timeout-direction :initarg :direction))
+ (:report
+ (lambda (condition stream)
+ (declare (type stream stream))
+ (format stream
+ "I/O timeout ~(~A~)ing ~S."
+ (io-timeout-direction condition)
+ (stream-error-stream condition)))))
+
+(define-condition deadline-timeout (timeout) ()
+ (:report (lambda (condition stream)
+ (format stream "A deadline was reached after ~A seconds."
+ (timeout-seconds condition)))))
(define-condition declaration-type-conflict-error (reference-condition
simple-error)
STEP-CONDITION-FORM holds the form, and STEP-CONDITION-RESULT holds
the values returned by the form as a list. No associated restarts."))
+(define-condition step-finished-condition (step-condition)
+ ()
+ (:report
+ (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream "Returning from STEP")))
+ #!+sb-doc
+ (:documentation "Condition signaled when STEP returns."))
+
\f
;;;; restart definitions
projects / sbcl.git / blobdiff