0.8.18.17:

	Merge Teemu Kalvas "several nice fixes to external format restarts"
	sbcl-devel 2005-01-07
	... not the extra exports, but some different exports instead;
	... frob SIMPLE-DECODING-ERROR signature so that the octets
		get reported correctly.

diff --git a/NEWS b/NEWS
index 74a3c78..1190b53 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,10 @@ changes in sbcl-0.8.19 relative to sbcl-0.8.18:
     directories works correctly.  (thanks to Artem V. Andreev)
   * build fix: fixed the dependence on *LOAD-PATHNAME* and
     *COMPILE-FILE-PATHNAME* being absolute pathnames.
+  * fixed some bugs related to Unicode integration:
+    ** encoding and decoding errors are now much more robustly
+       handled; it should now be possible to recover even from invalid
+       input or output to the terminal.  (thanks to Teemu Kalvas)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** the FORMATTER-generated functions for ~V[ conditionals require
        the correct number of arguments.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 076bbe4..3fb6d76 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -795,8 +795,9 @@ retained, possibly temporariliy, because it might be used internally."
                ;; FIXME: potential SB!EXT exports
               "CHARACTER-CODING-ERROR"
                "CHARACTER-DECODING-ERROR" "CHARACTER-DECODING-ERROR-OCTETS"
-               "CHARACTER-ENCODING-ERROR" "CHARACTER-ENCODING-ERROR-CHARACTER"
+               "CHARACTER-ENCODING-ERROR" "CHARACTER-ENCODING-ERROR-CODE"
                "STREAM-DECODING-ERROR" "STREAM-ENCODING-ERROR"
+              "ATTEMPT-RESYNC" "FORCE-END-OF-FILE"
 
               ;; bootstrapping magic, to make things happen both in
               ;; the cross-compilation host compiler's environment and

diff --git a/src/code/error.lisp b/src/code/error.lisp
index a0b0c2b..aae384b 100644 (file)
--- a/src/code/error.lisp
+++ b/src/code/error.lisp
@@ -89,7 +89,7 @@
 
 (define-condition character-coding-error (error) ())
 (define-condition character-encoding-error (character-coding-error)
-  ((character :initarg :character :reader character-encoding-error-character)))
+  ((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)
@@ -97,11 +97,11 @@
   (:report
    (lambda (c s)
      (let ((stream (stream-error-stream c))
-           (character (character-encoding-error-character 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)
-               (char-code character))))))
+               code)))))
 (define-condition stream-decoding-error (stream-error character-decoding-error)
   ()
   (:report

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 527474d..1f82f56 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -115,16 +115,16 @@
         :format-arguments
         (list note-format (list pathname) (strerror errno))))
 
-(defun stream-decoding-error (stream &rest octets)
+(defun stream-decoding-error (stream octets)
   (error 'stream-decoding-error
         :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 character)
+(defun stream-encoding-error (stream code)
   (error 'stream-encoding-error
         :stream stream
-         :character character))
+         :code code))
 
 ;;; This is called by the server when we can write to the given file
 ;;; descriptor. Attempt to write the data again. If it worked, remove
@@ -688,7 +688,19 @@
                             (setq size ,bytes)
                             (input-at-least ,stream-var size)
                             (setq ,element-var (locally ,@read-forms))))
-                      (stream-decoding-error ,stream-var)))
+                      (stream-decoding-error
+                       ,stream-var
+                       (if size
+                           (loop for i from 0 below size
+                                 collect (sap-ref-8 (fd-stream-ibuf-sap
+                                                     ,stream-var)
+                                                    (+ (fd-stream-ibuf-head
+                                                        ,stream-var)
+                                                       i)))
+                           (list (sap-ref-8 (fd-stream-ibuf-sap
+                                             ,stream-var)
+                                            (fd-stream-ibuf-head
+                                             ,stream-var)))))))
                 (attempt-resync ()
                   :report (lambda (stream)
                             (format stream
@@ -696,7 +708,7 @@
                                      character boundary and continue.~@:>"))
                   (,resync-function ,stream-var)
                   (setq ,retry-var t))
-                (end-of-file ()
+                (force-end-of-file ()
                   :report (lambda (stream)
                             (format stream
                                     "~@<Force an end of file.~@:>"))
@@ -1041,8 +1053,7 @@
        *external-formats*)))))
 
 (defmacro define-external-format/variable-width (external-format out-size-expr
-                                                out-expr in-size-expr in-expr
-                                                resync-expr)
+                                                out-expr in-size-expr in-expr)
   (let* ((name (first external-format))
         (out-function (intern (let ((*print-case* :upcase))
                                 (format nil "OUTPUT-BYTES/~A" name))))
@@ -1111,12 +1122,12 @@
                 (sap (fd-stream-ibuf-sap stream)))
            (declare (type index head tail))
            ;; Copy data from stream buffer into user's buffer.
-           (do ()
+           (do ((size nil nil))
                ((or (= tail head) (= requested total-copied)))
              (restart-case
                  (unless (block character-decode
-                           (let* ((byte (sap-ref-8 sap head))
-                                  (size ,in-size-expr))
+                           (let ((byte (sap-ref-8 sap head)))
+                             (setq size ,in-size-expr)
                              (when (> size (- tail head))
                                (return))
                              (setf (aref buffer (+ start total-copied))
@@ -1126,7 +1137,17 @@
                    (setf (fd-stream-ibuf-head stream) head)
                    (if (plusp total-copied)
                        (return-from ,in-function total-copied)
-                       (stream-decoding-error stream)))
+                       (stream-decoding-error
+                        stream
+                        (if size
+                            (loop for i from 0 below size
+                                  collect (sap-ref-8 (fd-stream-ibuf-sap
+                                                      stream)
+                                                     (+ (fd-stream-ibuf-head
+                                                         stream)
+                                                        i)))
+                            (list (sap-ref-8 (fd-stream-ibuf-sap stream)
+                                             (fd-stream-ibuf-head stream)))))))
                (attempt-resync ()
                  :report (lambda (stream)
                            (format stream
@@ -1134,7 +1155,7 @@
                                     character boundary and continue.~@:>"))
                  (,resync-function stream)
                  (setf head (fd-stream-ibuf-head stream)))
-               (end-of-file ()
+               (force-end-of-file ()
                  :report (lambda (stream)
                            (format stream "~@<Force an end of file.~@:>"))
                  (if eof-error-p
@@ -1161,7 +1182,15 @@
        (let ((byte (sap-ref-8 sap head)))
          ,in-expr))
       (defun ,resync-function (stream)
-       ,resync-expr)
+        (loop (input-at-least stream 1)
+              (incf (fd-stream-ibuf-head stream))
+              (when (block character-decode
+                      (let* ((sap (fd-stream-ibuf-sap stream))
+                             (head (fd-stream-ibuf-head stream))
+                             (byte (sap-ref-8 sap head))
+                             (size ,in-size-expr))
+                        ,in-expr))
+                (return))))
       (setf *external-formats*
        (cons '(,external-format ,in-function ,in-char-function ,out-function
               ,@(mapcar #'(lambda (buffering)
@@ -1174,14 +1203,14 @@
 (define-external-format (:latin-1 :latin1 :iso-8859-1)
     1
   (if (>= bits 256)
-      (stream-encoding-error stream byte)
+      (stream-encoding-error stream bits)
       (setf (sap-ref-8 sap tail) bits))
   (code-char byte))
 
 (define-external-format (:ascii :us-ascii :ansi_x3.4-1968)
     1
   (if (>= bits 128)
-      (stream-encoding-error stream byte)
+      (stream-encoding-error stream bits)
       (setf (sap-ref-8 sap tail) bits))
   (code-char byte))
 
@@ -1260,13 +1289,7 @@
                      (return-from character-decode))
                    (dpb byte (byte 3 18)
                         (dpb byte2 (byte 6 12)
-                             (dpb byte3 (byte 6 6) byte4)))))))
-  (loop (input-at-least stream 1)
-       (let ((byte (sap-ref-8 (fd-stream-ibuf-sap stream)
-                              (fd-stream-ibuf-head stream))))
-         (unless (<= #x80 byte #xc1)
-           (return)))
-       (incf (fd-stream-ibuf-head stream))))
+                             (dpb byte3 (byte 6 6) byte4))))))))
 \f
 ;;;; utility functions (misc routines, etc)
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 438ceb2..971ce00 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.18.16"
+"0.8.18.17"