Rightest one attached here - using (char-code *substitution-char*) instead of *substitution-char* itself.

Sorry again, -Anton

Anton Vodonosov:

Sorry, patch in previouse message contains few copy-pasted lines that I forgot to remove. Right version is attached.

-Anton

Anton Vodonosov:

...

Hi!

Edi, what do you think about following refactoring.

Remove *provide-use-value-restart* variable, but save performance.

To avoid verbose description, I've attached a patch. It is only a sketch of how it can be done, I event haven't compiled it.

Thus public interface of the library may be simplified, at the cost of more complex responsibilities of char-readers defined using define-char-reader macro: they should use recover-from-encoding-error.

By the way. May be define-char-code-reader is more accurate name for the macro than define-cahr-reader

Regards, -Anton

--- input.lisp 2007-02-24 23:36:16.237125400 +0200 +++ input+.lisp 2007-02-25 00:48:08.718168600 +0200 @@ -150,52 +150,50 @@ (last-char-code flexi-stream-last-char-code)) ,stream-var ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after ;; this operation (setq last-octet nil) (let ((,char-code (flet ((,body-fn () ,@body)) (declare (inline ,body-fn) (dynamic-extent (function ,body-fn))) - (cond (*provide-use-value-restart* - (restart-case - (handler-bind ((flexi-stream-encoding-error - (lambda (condition) - (declare (ignore condition)) - (when *substitution-char* - (use-value *substitution-char*))))) - (,body-fn)) - (use-value (,char) - :report "Specify a character to be used instead." - :interactive (lambda () - (loop - (format *query-io* "Type a character: ") - (let ((,line (read-line *query-io*))) - (when (= 1 (length ,line)) - (return (list (char ,line 0))))))) - (char-code ,char)))) - (t (,body-fn)))))) + (,body-fn)))) (when (eq ,char-code :eof) (return-from stream-read-char :eof)) ;; remember this character and the current external format ;; for UNREAD-CHAR (setq last-char-code ,char-code) (or (code-char ,char-code) ,char-code))))))

(define-char-reader (stream flexi-latin-1-input-stream) (or (read-byte* stream) (return-from stream-read-char :eof)))

(define-char-reader (stream flexi-ascii-input-stream) (let ((octet (or (read-byte* stream) (return-from stream-read-char :eof)))) (declare (type octet octet)) - (when (> octet 127) - (signal-encoding-error stream "No character which corresponds to octet #x~X." octet)) - octet)) + (if (> octet 127) + (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) + octet))) + +(defun recover-from-encoding-error (flexi-stream format-control &rest format-args) + (if *substitution-char* + (char-code *substitution-char*) + (restart-case + (apply #'signal-encoding-error `(flexi-stream fromat-control @,format-args)) + (use-value (,char) + :report "Specify a character to be used instead." + :interactive (lambda () + (loop + (format *query-io* "Type a character: ") + (let ((,line (read-line *query-io*))) + (when (= 1 (length ,line)) + (return (list (char ,line 0))))))) + (char-code ,char))))

(define-char-reader (stream flexi-8-bit-input-stream) (with-accessors ((encoding-table flexi-stream-encoding-table)) stream (let* ((octet (or (read-byte* stream) (return-from stream-read-char :eof))) (char-code (aref (the (simple-array * *) encoding-table) octet))) (declare (type octet octet))

Patch is attached.

And one note. In the DEFINE-CHAR-READER macro we have:

... (when (eq ,char-code :eof) (return-from stream-read-char :eof)) ...

but in all usages of DEFINE-CHAR-READER :eof returned directly from STREAM-READ-CHAR.

So perhpaps this when may be removed, to gain in performance?

Regards, -Anton

Only in flexi-streams-0.10.3+: ascii.fas Only in flexi-streams-0.10.3+: ascii.lib Only in flexi-streams-0.10.3+: code-pages.fas Only in flexi-streams-0.10.3+: code-pages.lib diff -U 8 -wr flexi-streams-0.10.3/doc/index.html flexi-streams-0.10.3+/doc/index.html --- flexi-streams-0.10.3/doc/index.html 2007-02-19 09:48:02.000000000 +0200 +++ flexi-streams-0.10.3+/doc/index.html 2007-03-02 02:58:36.597180800 +0200 @@ -51,16 +51,17 @@ <p> <font color=red>Download shortcut:</font> <a href="http://weitz.de/files/flexi-streams.tar.gz">http://weitz.de/files/flexi-streams.tar.gz</a>. </blockquote>

<br>&nbsp;<br><h3><a class=none name="contents">Contents</a></h3> <ol> <li><a href="#example">Example usage</a> <li><a href="#install">Download and installation</a> + <li><a href="#backward-compatibility">Backward compatibility with version 10.0.3 and before</a> <li><a href="#mail">Support and mailing lists</a> <li><a href="#dictionary">The FLEXI-STREAMS dictionary</a> <ol> <li><a href="#external-formats">External formats</a> <ol> <li><a href="#make-external-format"><code>make-external-format</code></a> <li><a href="#external-format-name"><code>external-format-name</code></a> <li><a href="#external-format-eol-style"><code>external-format-eol-style</code></a> @@ -79,19 +80,17 @@ <li><a href="#make-flexi-stream"><code>make-flexi-stream</code></a> <li><a href="#flexi-stream-external-format"><code>flexi-stream-external-format</code></a> <li><a href="#flexi-stream-element-type"><code>flexi-stream-element-type</code></a> <li><a href="#flexi-stream-column"><code>flexi-stream-column</code></a> <li><a href="#flexi-stream-position"><code>flexi-stream-position</code></a> <li><a href="#flexi-stream-stream"><code>flexi-stream-stream</code></a> <li><a href="#unread-byte"><code>unread-byte</code></a> <li><a href="#peek-byte"><code>peek-byte</code></a> - <li><a href="#*use-replacement-char*"><code>*use-replacement-char*</code></a> <li><a href="#*substitution-char*"><code>*substitution-char*</code></a> - <li><a href="#*provide-use-value-restart*"><code>*provide-use-value-restart*</code></a> <li><a href="#octet"><code>octet</code></a> <li><a href="#flexi-stream-error"><code>flexi-stream-error</code></a> <li><a href="#flexi-stream-encoding-error"><code>flexi-stream-encoding-error</code></a> <li><a href="#flexi-stream-element-type-error"><code>flexi-stream-element-type-error</code></a> <li><a href="#flexi-stream-element-type-error-element-type"><code>flexi-stream-element-type-error-element-type</code></a> <li><a href="#flexi-stream-position-spec-error"><code>flexi-stream-position-spec-error</code></a> <li><a href="#flexi-stream-position-spec-error-position-spec"><code>flexi-stream-position-spec-error-position-spec</code></a> </ol> @@ -241,16 +240,34 @@ <p> You can run a test suite which tests <em>some</em> (but not <em>all</em>) aspects of the library with <pre> (asdf:oos 'asdf:test-op :flexi-streams) </pre> This might take a while...

+<!-- this chapter may be removed after several versions --> +<br>&nbsp;<br> +<h3><a name="backward-compatibility" class=none> +Backward compatibility with version 10.0.3 and before</a></h3> + +Two special variables used in flexi-streams 10.0.3 and before were removed: +<code>*PROVIDE-USE-VALUE-RESTART*</code> and <code>*USE-REPLACEMENT-CHAR*</code>. + +<p> + +<a href="#flexi-streams">flexi streams</a> now behave as if +<code>*PROVIDE-USE-VALUE-RESTART*</code> is always <code>T</code>. +Instead of <code>*USE-REPLACEMENT-CHAR*</code> use +<a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> or +invoke <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> +restart</a> when <a href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> +is signaled. + <br>&nbsp;<br><h3><a name="mail" class=none>Support and mailing lists</a></h3>

For questions, bug reports, feature requests, improvements, or patches please use the <a href="http://common-lisp.net/mailman/listinfo/flexi-streams-devel">flexi-streams-devel mailing list</a>. If you want to be notified about future releases, subscribe to the <a href="http://common-lisp.net/mailman/listinfo/flexi-streams-announce">flexi-streams-announce @@ -685,92 +702,68 @@ returned, if <code><i>peek-type</i></code> is <code>T</code>, the next octet which is not <code>0</code> is returned, if <code><i>peek-type</i></code> is an octet, the next octet which equals <code><i>peek-type</i></code> is returned. <code><i>eof-error-p</i></code> and <code><i>eof-value</i></code> are interpreted as usual. <p> Note that the parameters aren't in the same order as with <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_peek_c.htm"><code>PEEK-CHAR</code></a> because it doesn't make much sense to make <code><i>stream</i></code> an optional argument. </blockquote>

<p><br>[Special variable] -<br><a class=none name="*use-replacement-char*"><b>*use-replacement-char*</b></a> - -<blockquote><br> -If this value is <em>true</em> (the default is <code>NIL</code>) and an unknown octet is encountered while reading with an 8-bit encoding, the replacement character (65533) is returned instead of signalling an error. -</blockquote> - -<p><br>[Special variable] <br><a class=none name="*substitution-char*"><b>*substitution-char*</b></a>

<blockquote><br> If this value is not NIL, it should be a character which is used (as if by a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> restart</a>) whenever during reading an error of type <a href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> would have been signaled otherwise. -This substitution will only happen if <a href="#*provide-use-value-restart*"><code>*PROVIDE-USE-VALUE-RESTART*</code></a> is true, though.

<pre> CL-USER 1 &gt; (defun foo () <font color=orange>;; not a valid UTF-8 sequence</font> (<a href="#with-input-from-sequence" class=noborder>with-input-from-sequence</a> (in '(#xe4 #xf6 #xfc)) (setq in (<a href="#make-flexi-stream" class=noborder>make-flexi-stream</a> in :external-format :utf8)) (read-line in))) FOO

-CL-USER 2 &gt; (setq <a href="#*provide-use-value-restart*" class=noborder><code>*provide-use-value-restart*</code></a> t) -T - -CL-USER 3 &gt; (foo) +CL-USER 2 &gt; (foo)

Error: Unexpected value #xF6 in UTF-8 sequence. 1 (continue) Specify a character to be used instead. 2 (abort) Return to level 0. 3 Return to top loop level 0.

Type :b for backtrace, :c &lt;option number&gt; to proceed, or :? for other options

-CL-USER 4 : 1 &gt; :c +CL-USER 3 : 1 &gt; :c Type a character: x

Error: End of file while in UTF-8 sequence. 1 (continue) Specify a character to be used instead. 2 (abort) Return to level 0. 3 Return to top loop level 0.

Type :b for backtrace, :c &lt;option number&gt; to proceed, or :? for other options

-CL-USER 5 : 1 &gt; :c +CL-USER 4 : 1 &gt; :c Type a character: y "xy" T

-CL-USER 6 &gt; (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#flexi-stream-encoding-error" class=noborder>flexi-stream-encoding-error</a> (lambda (condition) +CL-USER 5 &gt; (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#flexi-stream-encoding-error" class=noborder>flexi-stream-encoding-error</a> (lambda (condition) (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm" class=noborder>use-value</a> #-)))) (foo)) "--" T

-CL-USER 7 &gt; (let ((<a href="#*SUBSTITUTION-CHAR*" class=noborder>*substitution-char*</a> #?)) +CL-USER 6 &gt; (let ((<a href="#*SUBSTITUTION-CHAR*" class=noborder>*substitution-char*</a> #?)) (foo)) "??" T </pre> </blockquote>

-<p><br>[Special variable] -<br><a class=none name="*provide-use-value-restart*"><b>*provide-use-value-restart*</b></a> - -<blockquote><br> -Whether <a -href="http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_cha.htm%22%3E<code>READ-CHAR</code></a> -for flexi streams should provide a -<a -href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm%22%3E<code>USE-VALUE</code> -restart</a> in case an encoding error is encountered. This is not -done by default because it entails a performance penalty. -</blockquote> - <p><br>[Type] <br><a class=none name="octet"><b>octet</b></a>

<blockquote><br> Just a shortcut for <code>(UNSIGNED-BYTE&nbsp;8)</code>. </blockquote>

<p><br>[Condition] @@ -779,17 +772,18 @@ <blockquote><br> All errors related to <a href="#flexi-streams">flexi streams</a> are of this type. This is a subtype of <a href="http://www.lispworks.com/documentation/HyperSpec/Body/e_stm_er.htm"><code>STREAM-ERROR</code></a>. </blockquote>

<p><br>[Condition] <br><a class=none name="flexi-stream-encoding-error"><b>flexi-stream-encoding-error</b></a>

<blockquote><br> -All errors related to encoding problems with <a href="#flexi-streams">flexi streams</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) This is a subtype of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a>. +All errors related to encoding problems with <a href="#flexi-streams">flexi streams</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) When this condition is signaled during reading, <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> +restart</a> is provided. See also <a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> and example for it. <a href="#flexi-encodingstream-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> is a subtype of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a>. </blockquote>

<p><br>[Condition] <br><a class=none name="flexi-stream-element-type-error"><b>flexi-stream-element-type-error</b></a>

<blockquote><br> All errors related to problems with the element type of <a href="#flexi-streams">flexi streams</a> are of this type. This is a subtype of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a> and has an additional slot for the element type which can be accessed with <a href="#flexi-stream-element-type-error-element-type"><code>FLEXI-STREAM-ELEMENT-TYPE-ERROR-ELEMENT-TYPE</code></a>. </blockquote> Only in flexi-streams-0.10.3+/doc: index.html~ Only in flexi-streams-0.10.3+: external-format.fas Only in flexi-streams-0.10.3+: external-format.lib Only in flexi-streams-0.10.3+: in-memory.fas Only in flexi-streams-0.10.3+: in-memory.lib Only in flexi-streams-0.10.3+: input.fas Only in flexi-streams-0.10.3+: input.lib diff -U 8 -wr flexi-streams-0.10.3/input.lisp flexi-streams-0.10.3+/input.lisp --- flexi-streams-0.10.3/input.lisp 2007-02-24 23:36:16.237125400 +0200 +++ flexi-streams-0.10.3+/input.lisp 2007-03-03 04:27:55.606595200 +0200 @@ -133,90 +133,91 @@ (let ((octets-read (translate-char char-code external-format))) (decf position (length octets-read)) (setq octet-stack (append octets-read octet-stack)))))

(defmacro define-char-reader ((stream-var stream-class) &body body) "Helper macro to define methods for STREAM-READ-CHAR. Defines a method for the class STREAM-CLASS using the variable STREAM-VAR and the code body BODY wrapped with some standard code common to -all methods defined here." +all methods defined here. Return value of the BODY is a character +code. Note: In case of encoding problems BODY must return value +returned by (RECOVER-FROM-ENCODING-ERROR ...)." (with-unique-names (char char-code line body-fn) `(defmethod stream-read-char ((,stream-var ,stream-class)) "This method was generated with the DEFINE-CHAR-READER macro." (declare (optimize speed)) ;; note that we do nothing for the :LF EOL style because we ;; assume that #\Newline is the same as #\Linefeed in all ;; Lisps which will use this library (with-accessors ((last-octet flexi-stream-last-octet) (last-char-code flexi-stream-last-char-code)) ,stream-var ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after ;; this operation (setq last-octet nil) (let ((,char-code (flet ((,body-fn () ,@body)) (declare (inline ,body-fn) (dynamic-extent (function ,body-fn))) - (cond (*provide-use-value-restart* - (restart-case - (handler-bind ((flexi-stream-encoding-error - (lambda (condition) - (declare (ignore condition)) - (when *substitution-char* - (use-value *substitution-char*))))) - (,body-fn)) - (use-value (,char) - :report "Specify a character to be used instead." - :interactive (lambda () - (loop - (format *query-io* "Type a character: ") - (let ((,line (read-line *query-io*))) - (when (= 1 (length ,line)) - (return (list (char ,line 0))))))) - (char-code ,char)))) - (t (,body-fn)))))) + (,body-fn)))) (when (eq ,char-code :eof) (return-from stream-read-char :eof)) ;; remember this character and the current external format ;; for UNREAD-CHAR (setq last-char-code ,char-code) (or (code-char ,char-code) ,char-code))))))

+(defun recover-from-encoding-error (flexi-stream format-control &rest format-args) + (if *substitution-char* + (char-code *substitution-char*) + (restart-case + (apply #'signal-encoding-error `(,flexi-stream ,format-control ,@format-args)) + (use-value (char) + :report "Specify a character to be used instead." + :interactive (lambda () + (loop + (format *query-io* "Type a character: ") + (let ((line (read-line *query-io*))) + (when (= 1 (length line)) + (return (list (char line 0))))))) + (char-code char))))) + (define-char-reader (stream flexi-latin-1-input-stream) (or (read-byte* stream) (return-from stream-read-char :eof)))

(define-char-reader (stream flexi-ascii-input-stream) (let ((octet (or (read-byte* stream) (return-from stream-read-char :eof)))) (declare (type octet octet)) - (when (> octet 127) - (signal-encoding-error stream "No character which corresponds to octet #x~X." octet)) - octet)) + (if (> octet 127) + (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) + octet)))

(define-char-reader (stream flexi-8-bit-input-stream) (with-accessors ((encoding-table flexi-stream-encoding-table)) stream (let* ((octet (or (read-byte* stream) (return-from stream-read-char :eof))) (char-code (aref (the (simple-array * *) encoding-table) octet))) (declare (type octet octet)) - (when (or (null char-code) - (and (= char-code 65533) - (not *use-replacement-char*))) - (signal-encoding-error stream "No character which corresponds to octet #x~X." octet)) - char-code))) + (if (or (null char-code) + (= char-code 65533)) + (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) + char-code))))

(define-char-reader (stream flexi-utf-8-input-stream) + (block body (let (first-octet-seen) (flet ((read-next-byte () (prog1 (or (read-byte* stream) (cond (first-octet-seen - (signal-encoding-error stream "End of file while in UTF-8 sequence.")) + (return-from body + (recover-from-encoding-error stream "End of file while in UTF-8 sequence."))) (t (return-from stream-read-char :eof)))) (setq first-octet-seen t)))) (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) (let ((octet (read-next-byte))) (declare (type octet octet)) (multiple-value-bind (start count) (cond ((zerop (logand octet #b10000000)) (values octet 0)) @@ -225,104 +226,117 @@ ((= #b11100000 (logand octet #b11110000)) (values (logand octet #b00001111) 2)) ((= #b11110000 (logand octet #b11111000)) (values (logand octet #b00000111) 3)) ((= #b11111000 (logand octet #b11111100)) (values (logand octet #b00000011) 4)) ((= #b11111100 (logand octet #b11111110)) (values (logand octet #b00000001) 5)) - (t (signal-encoding-error stream "Unexpected value #x~X at start of UTF-8 sequence." - octet))) + (t (return-from body + (recover-from-encoding-error stream + "Unexpected value #x~X at start of UTF-8 sequence." + octet)))) ;; note that we currently don't check for "overlong" ;; sequences or other illegal values (loop for result of-type (unsigned-byte 32) = start then (+ (ash result 6) (logand octet #b111111)) repeat count for octet of-type octet = (read-next-byte) unless (= #b10000000 (logand octet #b11000000)) - do (signal-encoding-error stream "Unexpected value #x~X in UTF-8 sequence." octet) - finally (return result))))))) + do (return-from body + (recover-from-encoding-error stream "Unexpected value #x~X in UTF-8 sequence." octet)) + finally (return result))))))))

(define-char-reader (stream flexi-utf-16-le-input-stream) + (block body (let (first-octet-seen) (labels ((read-next-byte () (prog1 (or (read-byte* stream) (cond (first-octet-seen - (signal-encoding-error stream "End of file while in UTF-16 sequence.")) + (return-from body + (recover-from-encoding-error stream "End of file while in UTF-16 sequence."))) (t (return-from stream-read-char :eof)))) (setq first-octet-seen t))) (read-next-word () (+ (the octet (read-next-byte)) (ash (the octet (read-next-byte)) 8)))) (declare (inline read-next-byte read-next-word) (dynamic-extent (function read-next-byte) (function read-next-word))) (let ((word (read-next-word))) (cond ((<= #xd800 word #xdfff) (let ((next-word (read-next-word))) (unless (<= #xdc00 next-word #xdfff) - (signal-encoding-error stream "Unexpected UTF-16 word #x~X following #x~S." - next-word word)) + (return-from body + (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." + next-word word))) (+ (ash (logand #b1111111111 word) 10) (logand #b1111111111 next-word) #x10000))) - (t word)))))) + (t word)))))))

(define-char-reader (stream flexi-utf-16-be-input-stream) + (block body (let (first-octet-seen) (labels ((read-next-byte () (prog1 (or (read-byte* stream) (cond (first-octet-seen - (signal-encoding-error stream "End of file while in UTF-16 sequence.")) + (return-from body + (recover-from-encoding-error stream "End of file while in UTF-16 sequence."))) (t (return-from stream-read-char :eof)))) (setq first-octet-seen t))) (read-next-word () (+ (ash (the octet (read-next-byte)) 8) (the octet (read-next-byte))))) (let ((word (read-next-word))) (cond ((<= #xd800 word #xdfff) (let ((next-word (read-next-word))) (unless (<= #xdc00 next-word #xdfff) - (signal-encoding-error stream "Unexpected UTF-16 word #x~X following #x~S." - next-word word)) + (return-from body + (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." + next-word word))) (+ (ash (logand #b1111111111 word) 10) (logand #b1111111111 next-word) #x10000))) - (t word)))))) + (t word)))))))

(define-char-reader (stream flexi-utf-32-le-input-stream) + (block body (let (first-octet-seen) (flet ((read-next-byte () (prog1 (or (read-byte* stream) (cond (first-octet-seen - (signal-encoding-error stream "End of file while in UTF-32 sequence.")) + (return-from body + (recover-from-encoding-error stream "End of file while in UTF-32 sequence."))) (t (return-from stream-read-char :eof)))) (setq first-octet-seen t)))) (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) (loop for count from 0 to 24 by 8 for octet of-type octet = (read-next-byte) - sum (ash octet count))))) + sum (ash octet count))))))

(define-char-reader (stream flexi-utf-32-be-input-stream) + (block body (let (first-octet-seen) (flet ((read-next-byte () (prog1 (or (read-byte* stream) (cond (first-octet-seen - (signal-encoding-error stream "End of file while in UTF-32 sequence.")) + (return-from body + (recover-from-encoding-error stream "End of file while in UTF-32 sequence."))) (t (return-from stream-read-char :eof)))) (setq first-octet-seen t)))) (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) (loop for count from 24 downto 0 by 8 for octet of-type octet = (read-next-byte) - sum (ash octet count))))) + sum (ash octet count))))))

(defmethod stream-read-char ((stream flexi-cr-mixin)) "The `base' method for all streams which need end-of-line conversion. Uses CALL-NEXT-METHOD to do the actual work of reading one or more characters from the stream." (declare (optimize speed)) (let ((char (call-next-method))) (when (eq char :eof) Only in flexi-streams-0.10.3+: input.lisp~ Only in flexi-streams-0.10.3+: iso-8859.fas Only in flexi-streams-0.10.3+: iso-8859.lib Only in flexi-streams-0.10.3+: koi8-r.fas Only in flexi-streams-0.10.3+: koi8-r.lib Only in flexi-streams-0.10.3+: output.fas Only in flexi-streams-0.10.3+: output.lib Only in flexi-streams-0.10.3+: packages.fas Only in flexi-streams-0.10.3+: packages.lib diff -U 8 -wr flexi-streams-0.10.3/packages.lisp flexi-streams-0.10.3+/packages.lisp --- flexi-streams-0.10.3/packages.lisp 2007-01-02 01:46:50.000000000 +0200 +++ flexi-streams-0.10.3+/packages.lisp 2007-03-02 02:41:17.543094400 +0200 @@ -34,18 +34,16 @@

(defpackage :flexi-streams (:use :cl :trivial-gray-streams) (:nicknames :flex) #+:lispworks (:shadow :with-accessors) (:export :*default-eol-style* :*default-little-endian* - :*provide-use-value-restart* - :*use-replacement-char* :*substitution-char* :external-format-eol-style :external-format-equal :external-format-id :external-format-little-endian :external-format-name :flexi-input-stream :flexi-output-stream Only in flexi-streams-0.10.3+: specials.fas Only in flexi-streams-0.10.3+: specials.lib diff -U 8 -wr flexi-streams-0.10.3/specials.lisp flexi-streams-0.10.3+/specials.lisp --- flexi-streams-0.10.3/specials.lisp 2007-01-02 01:46:50.000000000 +0200 +++ flexi-streams-0.10.3+/specials.lisp 2007-03-02 02:40:02.895756800 +0200 @@ -119,32 +119,21 @@

(defvar *default-little-endian* #+:little-endian t #-:little-endian nil "Whether external formats are little-endian by default (i.e. unless explicitly specified). Depends on the platform the code is compiled on.")

-(defvar *use-replacement-char* nil - "Whether reading an unknown octet for an 8-bit encoding should -return the replacement character (65533) instead of signalling an -error.") - (defvar *substitution-char* nil "If this value is not NIL, it should be a character which is used (as if by a USE-VALUE restart) whenever during reading an error of type FLEXI-STREAM-ENCODING-ERROR would have been -signaled otherwise. This substitution will only happen if -*PROVIDE-USE-VALUE-RESTART* is true, though.") - -(defvar *provide-use-value-restart* nil - "Whether READ-CHAR for flexi streams should provide a USE-VALUE -restart in case an encoding error is encountered. This is not done by -default because it entails a performance penalty.") +signaled otherwise.")

(defun invert-table (table) "`Inverts' an array which maps octets to character codes to a hash tables which maps character codes to octets." (let ((hash (make-hash-table))) (loop for octet from 0 for char-code across table unless (= char-code 65533) Only in flexi-streams-0.10.3+: specials.lisp~ Only in flexi-streams-0.10.3+: stream.fas Only in flexi-streams-0.10.3+: stream.lib Only in flexi-streams-0.10.3+: strings.fas Only in flexi-streams-0.10.3+: strings.lib Only in flexi-streams-0.10.3+/test: lisp.exe.stackdump Only in flexi-streams-0.10.3+/test: packages.fas Only in flexi-streams-0.10.3+/test: packages.lib Only in flexi-streams-0.10.3+/test: test.fas Only in flexi-streams-0.10.3+/test: test.lib diff -U 8 -wr flexi-streams-0.10.3/test/test.lisp flexi-streams-0.10.3+/test/test.lisp --- flexi-streams-0.10.3/test/test.lisp 2007-01-02 01:47:18.000000000 +0200 +++ flexi-streams-0.10.3+/test/test.lisp 2007-03-03 04:31:17.577014400 +0200 @@ -49,17 +49,17 @@ '(("kafka" (:utf8 :latin1 :cp1252)) ("tilton" (:utf8 :ascii)) ("hebrew" (:utf8 :latin8)) ("russian" (:utf8 :koi8r)) ("unicode_demo" (:utf8 :ucs2 :ucs4))) "A list of test files where each entry consists of the name prefix and a list of encodings.")

-(defvar *test-counter* 0 +(defvar *test-success-counter* 0 "Counts the number of successful tests.")

(defun create-file-variants (file-name symbol) "For a name suffix FILE-NAME and a symbol SYMBOL denoting an encoding returns a list of pairs where the car is a full file name and the cdr is the corresponding external format. This list contains all possible variants w.r.t. to line-end conversion and endianness." @@ -168,39 +168,224 @@ (dolist (direction-in '(:input :io)) (format *error-output* "Test ~S ~S [~A]~% --> ~S [~A].~%" path-in (flex::normalize-external-format external-format-in) direction-in (flex::normalize-external-format external-format-out) direction-out) (copy-file full-path-in external-format-in full-path-out external-format-out direction-out direction-in) (cond ((file-equal full-path-out full-path-orig) - (incf *test-counter*)) + (incf *test-success-counter*)) (t (format *error-output* " Test failed!!!~%"))) (terpri *error-output*) #+:lispworks (format *error-output* "LW-Test ~S ~S [~A]~% --> ~S [~A].~%" path-in (flex::normalize-external-format external-format-in) direction-in (flex::normalize-external-format external-format-out) direction-out) #+:lispworks (copy-file full-path-in external-format-in full-path-out external-format-out direction-out direction-in) #+:lispworks (cond ((file-equal full-path-out full-path-orig) - (incf *test-counter*)) + (incf *test-success-counter*)) (t (format *error-output* " Test failed!!!~%"))) (terpri *error-output*)))))

+(defmacro with-test ((test-description) &body body) + "Defines a test. Three following utilities are available +inside of body of the maco: FAIL function, CHECK and CHECK-SIGNALED +macros. FAIL is the lowest level util, marks the test +defined by WITH-TEST as failded. CHECK ensures that passed +expression value is T, otherwise it calls FAIL. If during +evaluation of the specified expression any condition is +signaled it is considered as a fail too. CHECK-SIGNALLED +ensures that condition of specified typespec is signalled +by passed expression, otherwise (no condition or a condition +of unappropriate type is signaled) it calls FAIL. + +WITH-TEST prints all necessary reporting. Also it +increments *TEST-SUCCESS-COUNT* in case if test +was successfull. + +Example: + + (with-test ((string 'demo-test)) + (check (> 2 1)) + (check (> 1 1)) ; fails because of this + (check-signaled warning + (error (string 'zu2))) ; and this + (check-signaled + (or error arithmetic-error) (error (string 'zu))))" + + (let ((description-value test-description) + (succeeded-var (gensym "succeeded"))) + `(let ((,succeeded-var t)) + (flet ((fail (format-str &rest format-args) + (setf ,succeeded-var nil) + (apply #'format `(,*error-output* ,format-str ,@format-args)))) + (macrolet ((check (expression) + `(handler-case + (when (not ,expression) + (fail "Expression ~S failed.~%" (quote ,expression))) + (condition (c) + (fail "Expression ~S failed signaling condition of type ~A: ~A.~%" + (quote ,expression) (type-of c) c)))) + (check-signaled (typespec &body expression) + `(handler-case + ,@expression + (,typespec ()) ;; ok, as expected + (t (c) ;; if any other type is signalled - fail + (fail "Expression ~S failed: unexpected condition of type ~A signaled; expected is ~S.~%" + (quote ,@expression) (type-of c) (quote ,typespec))) + (:no-error (&rest unused) ;; no condition was signaled - fail too + (declare (ignore unused)) + (fail "Expression ~S failed: no condition was signaled, while condition of type ~S is expected.~%" + (quote ,@expression) (quote ,typespec)))))) + (format *error-output* "Test "~A"~%", description-value) + ;; may be used + ;; (incf *number-of-tests*) + ,@body + (if ,succeeded-var + (incf *test-success-counter*) + (format *error-output* " Test failed!!!~%")) + (terpri *error-output*) + (terpri *error-output*)) + ,succeeded-var)))) + +(define-condition using-values-error (condition) + ((format-control :initarg :format-control + :initform "USING-VALUES error" + :reader format-control) + (format-arguments :initarg :format-arguments + :initform (format t "zu") + :reader format-arguments)) + (:report (lambda (condition stream) + (apply #'format `(,stream ,(format-control condition) ,@(format-arguments condition))))) + (:documentation "This condition is signalled by USING-VALUES +macro when its body signals FLEXI-STREAM-ENCODING-ERROR different +number of times that is specified by argument VALUES of USING-VALUES +macro")) + +(defun signal-using-values-error (format-control &rest format-arguments) + (error 'using-values-error :format-control format-control :format-arguments format-arguments)) + +(defmacro using-values ((&rest values) &body body) + "Body of USING-VALUES must signall FLEXI-STREAM-ENCODING-ERROR +number of times equal to number of VALUES provided to USING-VALUES. +Corresponded element from VALUES will be passed to USE-VALUE restart +each time. +If FLEXI-STREAM-ENCODING-ERROR was signalled another number of +times, USING-VALUES-ERROR is signalled. +In case when FLEXI-STREAM-ENCODING-ERROR was signalled appropriate +number of times USING-VALUES returns result of body execution." + (let ((body-result-var (gensym "body-result-")) + (values-var (gensym "values-")) + (signaled-count-var (gensym "signaled-count-")) + (values-count-var (gensym "values-count-var-")) + (catch-tag (gensym "catch-tag-"))) + `(let ((,values-var (quote ,values)) + (,signaled-count-var 0) + (,values-count-var ,(length values))) + (handler-bind + ((flexi-stream-encoding-error + #'(lambda (c) + (declare (ignore c)) + (when (null ,values-var) + ;; We are run out of values - too many conditions were signaled. + (signal-using-values-error "Too many flexi-stream-encoding-errors signaled, expected only ~A." + ,values-count-var)) + (incf ,signaled-count-var) + (use-value (pop ,values-var)))) + ;; allow using-values-error's to go out + (using-values-error #'(lambda (c) (error c))) + (t #'(lambda (c) + ;; All other condition types are considered as errors. + (signal-using-values-error "Condition of type ~A: <~A> is signalled instead of ~A. ~%" + (type-of c) + c + 'flexi-stream-encoding-errror)))) + (let ((,body-result-var ,@body)) + (when ,values-var + ;; Not all supplied values were exhausted, it is an error too. + (signal-using-values-error "~A flexi-stream-encoding-error's signaled but ~A expected." + ,signaled-count-var + ,values-count-var)) + ,body-result-var))))) + +(defun read-flexi-line (sequence external-format) + (with-input-from-sequence (in sequence) + (setq in (make-flexi-stream in :external-format external-format)) + (read-line in))) + +(defun encoding-error-handling-test() + (with-test ("Encoding error handling") + + (let ((*substitution-char* #?)) + + ;; :ascii doesn't have characters with char codes > 127 + (check (string= "a??" (read-flexi-line `(,(char-code #\a) 128 200) :ascii))) + + ;; :windows-1253 encoding doesn't have a charactes with codes 170 and 210 + (check (string= "a??" (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253))) + + ;; not a valid utf-8 sequence + (check (string= "??" (read-flexi-line `(#xe4 #xf6 #xfc) :utf8))) + ;; utf-8 can't start neither with #b11111110 nor with #b11111111 + (check (string= "??" (read-flexi-line `(#b11111110 #b11111111) :utf8)))) + + (let ((*substitution-char* nil)) + + ;; :ascii doesn't have characters with char codes > 127 + (check (string= "abc" (using-values (#\b #\c) (read-flexi-line `(,(char-code #\a) 128 200) :ascii)))) + + ;; :windows-1253 encoding doesn't have a charactes with codes 170 and 210 + (check (string= "axy" (using-values (#\x #\y) (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253)))) + + ;; not a valid utf-8 sequence + (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line `(#xe4 #xf6 #xfc) :utf8)))) + ;; utf-8 can't start neither with #b11111110 nor with #b11111111 + (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line `(#b11111110 #b11111111) :utf8)))) + + ;; invalid utf-16le + ;; only one byte + (check (string= "E" (using-values (#\E) (read-flexi-line `(#x01) :utf-16le)))) + ;; two bytes, but value of resulting word assumes that another word follows + (check (string= "R" (using-values (#\R) (read-flexi-line `(#x01 #xd8) :utf-16le)))) + ;; the second word must fit into the [#xdc00; #xdfff] interval, but it is #xdbff + (check (string= "T" (using-values (#\T) (read-flexi-line `(#x01 #xd8 #xff #xdb) :utf-16le)))) + + ;; invalid utf-16be + ;; the same as for little endian, but using inverse order of bytes in words + (check (string= "E" (using-values (#\E) (read-flexi-line `(#x01) :utf-16be)))) + (check (string= "R" (using-values (#\R) (read-flexi-line `(#xd8 #x01) :utf-16be)))) + (check (string= "T" (using-values (#\T) (read-flexi-line `(#xd8 #x01 #xdb #xff) :utf-16be)))) + + ;; the only case when error is signaled for utf-32 is at end of file + ;; in the middle of 4-byte sequence, both for big and little endians + (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01) :utf-32le)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01 #x01) :utf-32le)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01 #x01 #x01) :utf-32le)))) + (check (string= "aY" (using-values (#\Y) (read-flexi-line `(,(char-code #\a) #x00 #x00 #x00 #x01) :utf-32le)))) + + (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01) :utf-32be)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01 #x01) :utf-32be)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01 #x01 #x01) :utf-32be)))) + (check (string= "aY" (using-values (#\Y) (read-flexi-line `(#x00 #x00 #x00 ,(char-code #\a) #x01) :utf-32be))))))) + (defun run-tests () "Applies COMPARE-FILES to all test scenarios created with CREATE-TEST-COMBINATIONS and shows simple statistics at the end." - (let* ((*test-counter* 0) + (let* ((*test-success-counter* 0) (args-list (loop for (file-name symbols) in *test-files* nconc (create-test-combinations file-name symbols))) (no-tests (* 4 (length args-list)))) #+:lispworks (setq no-tests (* 2 no-tests)) (dolist (args args-list) (apply #'compare-files args)) + + (incf no-tests) + (encoding-error-handling-test) + (format *error-output* "~%~%~:[~A of ~A tests failed..~;~*All ~A tests passed~].~%" - (= no-tests *test-counter*) (- no-tests *test-counter*) no-tests))) + (= no-tests *test-success-counter*) (- no-tests *test-success-counter*) no-tests)))

Only in flexi-streams-0.10.3+/test: test.lisp~ Only in flexi-streams-0.10.3+: util.fas Only in flexi-streams-0.10.3+: util.lib