From 4e7866afc56e4eec4e33dc2d61bd4f0aeed72cfd Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 19 Apr 2012 13:43:33 +0300 Subject: [PATCH] associate stream decoding and encoding errors with their restarts ERROR call needs to appear inline for that to happen without extra acrobatics. --- src/code/fd-stream.lisp | 31 +++++++++++-------------------- tests/alien.impure.lisp | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 20 deletions(-) diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 311a4b9..b973113 100644 --- 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 "~@")) diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp index ff4f65b..aa6eee6 100644 --- 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 -- 1.7.10.4