associate stream decoding and encoding errors with their restarts

  ERROR call needs to appear inline for that to happen without
  extra acrobatics.

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 311a4b9..b973113 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -426,19 +426,6 @@
          :format-arguments
          (list note-format (list pathname) (strerror errno))))
 
-(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))
-
 (defun c-string-encoding-error (external-format code)
   (error 'c-string-encoding-error
          :external-format external-format
@@ -452,12 +439,13 @@
 ;;; round of input buffer filling followed by re-entering character decode.
 (defun stream-decoding-error-and-handle (stream octet-count)
   (restart-case
-      (stream-decoding-error stream
-                             (let* ((buffer (fd-stream-ibuf stream))
-                                    (sap (buffer-sap buffer))
-                                    (head (buffer-head buffer)))
-                               (loop for i from 0 below octet-count
-                                     collect (sap-ref-8 sap (+ head i)))))
+      (error 'stream-decoding-error
+             :external-format (stream-external-format stream)
+             :stream stream
+             :octets (let ((buffer (fd-stream-ibuf stream)))
+                       (sap-ref-octets (buffer-sap buffer)
+                                       (buffer-head buffer)
+                                       octet-count)))
     (attempt-resync ()
       :report (lambda (stream)
                 (format stream
@@ -489,7 +477,10 @@
 
 (defun stream-encoding-error-and-handle (stream code)
   (restart-case
-      (stream-encoding-error stream code)
+      (error 'stream-encoding-error
+             :external-format (stream-external-format stream)
+             :stream stream
+             :code code)
     (output-nothing ()
       :report (lambda (stream)
                 (format stream "~@<Skip output of this character.~@:>"))

diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index ff4f65b..aa6eee6 100644 (file)
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -369,4 +369,39 @@
                            (sb-int:character-decoding-error-octets e)))
            :multibyte-2)))))
 
+(with-test (:name :stream-to-c-string-decoding-restart-leakage)
+  ;; Restarts for stream decoding errors didn't use to be associated with
+  ;; their conditions, so they could get confused with c-string decoding errors.
+  (assert (eq :nesting-ok
+              (catch 'out
+                (handler-bind ((sb-int:character-decoding-error
+                                 (lambda (stream-condition)
+                                   (handler-bind ((sb-int:character-decoding-error
+                                                    (lambda (c-string-condition)
+                                                      (throw 'out
+                                                        (if (find-restart
+                                                             'sb-impl::input-replacement
+                                                             c-string-condition)
+                                                            :bad-restart
+                                                            :nesting-ok)))))
+                                     (let ((c-string (coerce #(70 195 1 182 195 182 0)
+                                                             '(vector (unsigned-byte 8)))))
+                                       (sb-sys:with-pinned-objects (c-string)
+                                         (sb-alien::c-string-to-string
+                                          (sb-sys:vector-sap c-string)
+                                          :utf-8 'character)))))))
+                  (let ((namestring "alien.impure.tmp"))
+                    (unwind-protect
+                         (progn
+                           (with-open-file (f namestring
+                                              :element-type '(unsigned-byte 8)
+                                              :direction :output
+                                              :if-exists :supersede)
+                             (dolist (b '(70 195 1 182 195 182 0))
+                               (write-byte b f)))
+                           (with-open-file (f namestring
+                                              :external-format :utf-8)
+                             (read-line f)))
+                      (delete-file namestring))))))))
+
 ;;; success