X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ferror.lisp;h=1239eb44a33fa0ceed367982eba767d6277a3ba8;hb=740af378fef405f7d3735fd95423d90100a10beb;hp=1d6e5c74396e1b0b0141f5acafbc93f8a2c0a9ca;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/code/error.lisp b/src/code/error.lisp index 1d6e5c7..1239eb4 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -11,25 +11,26 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -(in-package "SB!CONDITIONS") +(in-package "SB!KERNEL") (define-condition simple-style-warning (simple-condition style-warning) ()) ;;; not sure this is the right place, but where else? (defun style-warn (format-control &rest format-arguments) + (/show0 "entering STYLE-WARN") + (/show format-control format-arguments) (warn 'simple-style-warning :format-control format-control :format-arguments format-arguments)) -(define-condition simple-type-error (simple-condition type-error) ()) - (define-condition sb!kernel:layout-invalid (type-error) () (:report (lambda (condition stream) - (format stream "Layout-invalid error in ~S:~@ - Type test of class ~S was passed obsolete instance:~% ~S" - (condition-function-name condition) + (format stream + "~@" (sb!kernel:class-proper-name (type-error-expected-type condition)) (type-error-datum condition))))) @@ -38,14 +39,16 @@ (possibilities :reader case-failure-possibilities :initarg :possibilities)) (:report (lambda (condition stream) - (format stream "~@<~S fell through ~S expression. ~:_Wanted one of ~:S.~:>" + (format stream "~@<~S fell through ~S expression. ~ + ~:_Wanted one of ~:S.~:>" (type-error-datum condition) (case-failure-name condition) (case-failure-possibilities condition))))) -(define-condition simple-file-error (simple-condition file-error)()) -(define-condition simple-program-error (simple-condition program-error)()) -(define-condition simple-control-error (simple-condition control-error)()) +(define-condition simple-control-error (simple-condition control-error) ()) +(define-condition simple-file-error (simple-condition file-error) ()) +(define-condition simple-program-error (simple-condition program-error) ()) +(define-condition simple-stream-error (simple-condition stream-error) ()) ;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that ;;; compiler warnings can be emitted as appropriate.