;;; The current code doesn't seem to quite match that.
(def!method print-object ((x condition) stream)
(if *print-escape*
- (print-unreadable-object (x stream :type t :identity t))
+ (if (and (typep x 'simple-condition) (slot-boundp x 'format-control))
+ (print-unreadable-object (x stream :type t :identity t)
+ (format stream "~S" (simple-condition-format-control x)))
+ (print-unreadable-object (x stream :type t :identity t)))
;; KLUDGE: A comment from CMU CL here said
;; 7/13/98 BUG? CPL is not sorted and results here depend on order of
;; superclasses in define-condition call!
',(all-writers)
(sb!c:source-location)))))))
\f
-;;;; DESCRIBE on CONDITIONs
-
-;;; a function to be used as the guts of DESCRIBE-OBJECT (CONDITION T)
-;;; eventually (once we get CLOS up and running so that we can define
-;;; methods)
-(defun describe-condition (condition stream)
- (format stream
- "~&~@<~S ~_is a ~S. ~_Its slot values are ~_~S.~:>~%"
- condition
- (type-of condition)
- (concatenate 'list
- (condition-actual-initargs condition)
- (condition-assigned-slots condition))))
-\f
;;;; various CONDITIONs specified by ANSI
(define-condition serious-condition (condition) ())
(define-condition type-warning (reference-condition simple-warning)
()
(:default-initargs :references (list '(:sbcl :node "Handling of Types"))))
+(define-condition type-style-warning (reference-condition simple-style-warning)
+ ()
+ (:default-initargs :references (list '(:sbcl :node "Handling of Types"))))
(define-condition local-argument-mismatch (reference-condition simple-warning)
()
;; Extract the bound from (INTEGER 0 (BOUND))
(caaddr (type-error-expected-type condition)))))))
+(define-condition invalid-array-error (reference-condition type-error) ()
+ (:report
+ (lambda (condition stream)
+ (let ((*print-array* nil))
+ (format stream
+ "~@<Displaced array originally of type ~S has been invalidated ~
+ due its displaced-to array ~S having become too small to hold ~
+ it: the displaced array's dimensions have all been set to zero ~
+ to trap accesses to it.~:@>"
+ (type-error-expected-type condition)
+ (array-displacement (type-error-datum condition))))))
+ (:default-initargs
+ :references
+ (list '(:ansi-cl :function adjust-array))))
+
(define-condition index-too-large-error (type-error)
()
(:report
(:default-initargs :references `((:ansi-cl :section (2 1 1 2))
(:ansi-cl :glossary "standard readtable"))))
+(define-condition standard-pprint-dispatch-table-modified-error
+ (reference-condition error)
+ ((operation :initarg :operation
+ :reader standard-pprint-dispatch-table-modified-operation))
+ (:report (lambda (condition stream)
+ (format stream "~S would modify the standard pprint dispatch table."
+ (standard-pprint-dispatch-table-modified-operation
+ condition))))
+ (:default-initargs
+ :references `((:ansi-cl :glossary "standard pprint dispatch table"))))
+
(define-condition timeout (serious-condition)
((seconds :initarg :seconds :initform nil :reader timeout-seconds))
(:report (lambda (condition stream)
Associated with this condition are always the restarts STEP-INTO,
STEP-NEXT, and STEP-CONTINUE."))
-#!+sb-doc
-(setf (fdocumentation 'step-condition-source-path 'function)
- "Source-path of the original form associated with the
-STEP-FORM-CONDITION or NIL."
- (fdocumentation 'step-condition-pathname 'function)
- "Pathname of the original source-file associated with the
-STEP-FORM-CONDITION or NIL.")
-
(define-condition step-result-condition (step-condition)
((result :initarg :result :reader step-condition-result)))