From: Richard M Kreuter <kreuter@users.sourceforge.net>
Date: Thu, 16 Oct 2008 21:28:46 +0000 (+0000)
Subject: 1.0.21.19: Eagerly find a stream's external-format when a coding-error occurs.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e7ef1082bd3e7f3851de9d90c5dbddf226a71382;p=sbcl.git

1.0.21.19: Eagerly find a stream's external-format when a coding-error occurs.

* Patch and test contributed by Zach Beane.
---

diff --git a/src/code/error.lisp b/src/code/error.lisp
index e886972..085264c 100644
--- a/src/code/error.lisp
+++ b/src/code/error.lisp
@@ -104,7 +104,8 @@
 (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-coding-error (error)
+  ((external-format :initarg :external-format :reader character-coding-error-external-format)))
 (define-condition character-encoding-error (character-coding-error)
   ((code :initarg :code :reader character-encoding-error-code)))
 (define-condition character-decoding-error (character-coding-error)
@@ -117,7 +118,8 @@
            (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)
+               stream ':external-format
+               (character-coding-error-external-format c)
                code)))))
 (define-condition stream-decoding-error (stream-error character-decoding-error)
   ()
@@ -127,25 +129,26 @@
            (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)
+               stream ':external-format
+               (character-coding-error-external-format c)
                octets)))))
 
 (define-condition c-string-encoding-error (character-encoding-error)
-  ((external-format :initarg :external-format :reader c-string-encoding-error-external-format))
+  ()
   (:report
    (lambda (c s)
      (format s "~@<c-string encoding error (:external-format ~S): ~2I~_~
                   the character with code ~D cannot be encoded.~@:>"
-               (c-string-encoding-error-external-format c)
+               (character-coding-error-external-format c)
                (character-encoding-error-code c)))))
 
 (define-condition c-string-decoding-error (character-decoding-error)
-  ((external-format :initarg :external-format :reader c-string-decoding-error-external-format))
+  ()
   (:report
    (lambda (c s)
      (format s "~@<c-string decoding error (:external-format ~S): ~2I~_~
                   the octet sequence ~S cannot be decoded.~@:>"
-             (c-string-decoding-error-external-format c)
+             (character-coding-error-external-format c)
              (character-decoding-error-octets c)))))
 
 (define-condition control-stack-exhausted (storage-condition)
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 5fde245..771cd10 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -418,12 +418,14 @@
 
 (defun stream-decoding-error (stream octets)
   (error 'stream-decoding-error
+         :external-format (stream-external-format stream)
          :stream stream
          ;; FIXME: dunno how to get at OCTETS currently, or even if
          ;; that's the right thing to report.
          :octets octets))
 (defun stream-encoding-error (stream code)
   (error 'stream-encoding-error
+         :external-format (stream-external-format stream)
          :stream stream
          :code code))
 
diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index 405fea1..99e2bda 100644
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -287,6 +287,23 @@
     (values)))
 (delete-file *test-path*)
 
+;;; We used to call STREAM-EXTERNAL-FORMAT on the stream in the error
+;;; when printing a coding error, but that didn't work if the stream
+;;; was closed by the time the error was printed.  See sbcl-devel
+;;; "Subject: Printing coding errors for closed streams" by Zach Beane
+;;; on 2008-10-16 for more info.
+(with-test (:name (:character-coding-error-stream-external-format))
+  (flet ((first-file-character ()
+           (with-open-file (stream *test-file* :external-format :utf-8)
+             (read-char stream))))
+    (with-open-file (stream *test-file*
+                            :direction :output
+                            :if-exists :supersede
+                            :element-type '(unsigned-byte 8))
+      (write-byte 192 stream))
+    (princ-to-string (nth-value 1 (ignore-errors (first-file-character))))))
+(delete-file *test-path*)
+
 ;;; External format support in SB-ALIEN
 
 (with-test (:name (:sb-alien :vanilla))