0.9.2.40:

[sbcl.git] / src / code / error.lisp

diff --git a/src/code/error.lisp b/src/code/error.lisp
index b409a4f..9d8082b 100644 (file)
--- a/src/code/error.lisp
+++ b/src/code/error.lisp
@@ -27,14 +27,14 @@
 ;;; single argument that's directly usable by all the other routines.
 (defun coerce-to-condition (datum arguments default-type fun-name)
   (cond ((typep datum 'condition)
 ;;; single argument that's directly usable by all the other routines.
 (defun coerce-to-condition (datum arguments default-type fun-name)
   (cond ((typep datum 'condition)

-        (if arguments
-            (cerror "Ignore the additional arguments."
-                    'simple-type-error
-                    :datum arguments
-                    :expected-type 'null
-                    :format-control "You may not supply additional arguments ~
-                                      when giving ~S to ~S."
-                    :format-arguments (list datum fun-name)))
+        (when (and arguments (not (eq fun-name 'cerror)))
+           (cerror "Ignore the additional arguments."
+                   'simple-type-error
+                   :datum arguments
+                   :expected-type 'null
+                   :format-control "You may not supply additional arguments ~
+                                    when giving ~S to ~S."
+                   :format-arguments (list datum fun-name)))

         datum)
        ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
         (apply #'make-condition datum arguments))
         datum)
        ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
         (apply #'make-condition datum arguments))

@@ -87,6 +87,32 @@
 (define-condition simple-stream-error  (simple-condition stream-error)  ())
 (define-condition simple-parse-error   (simple-condition parse-error)   ())
 
 (define-condition simple-stream-error  (simple-condition stream-error)  ())
 (define-condition simple-parse-error   (simple-condition parse-error)   ())
 

+(define-condition character-coding-error (error) ())
+(define-condition character-encoding-error (character-coding-error)
+  ((code :initarg :code :reader character-encoding-error-code)))
+(define-condition character-decoding-error (character-coding-error)
+  ((octets :initarg :octets :reader character-decoding-error-octets)))
+(define-condition stream-encoding-error (stream-error character-encoding-error)
+  ()
+  (:report
+   (lambda (c s)
+     (let ((stream (stream-error-stream c))
+           (code (character-encoding-error-code c)))
+       (format s "~@<encoding error on stream ~S (~S ~S): ~2I~_~
+                  the character with code ~D cannot be encoded.~@:>"
+               stream ':external-format (stream-external-format stream)
+               code)))))
+(define-condition stream-decoding-error (stream-error character-decoding-error)
+  ()
+  (:report
+   (lambda (c s)
+     (let ((stream (stream-error-stream c))
+           (octets (character-decoding-error-octets c)))
+       (format s "~@<decoding error on stream ~S (~S ~S): ~2I~_~
+                  the octet sequence ~S cannot be decoded.~@:>"
+               stream ':external-format (stream-external-format stream)
+               octets)))))
+

 (define-condition control-stack-exhausted (storage-condition)
   ()
   (:report
 (define-condition control-stack-exhausted (storage-condition)
   ()
   (:report

@@ -95,3 +121,9 @@
       (format stream
              "Control stack exhausted (no more space for function call frames).  This is probably due to heavily nested or infinitely recursive function calls, or a tail call that SBCL cannot or has not optimized away."))))
 
       (format stream
              "Control stack exhausted (no more space for function call frames).  This is probably due to heavily nested or infinitely recursive function calls, or a tail call that SBCL cannot or has not optimized away."))))
 

+(define-condition memory-fault-error (error)
+  ()
+  (:report
+   (lambda (condition stream)
+     (declare (ignore condition))
+     (format stream "memory fault"))))
\ No newline at end of file