Author: eweitz Date: Sat May 24 23:14:26 2008 New Revision: 55
Modified: branches/edi/conditions.lisp branches/edi/decode.lisp branches/edi/doc/index.html branches/edi/input.lisp branches/edi/packages.lisp branches/edi/strings.lisp branches/edi/test/test.lisp branches/edi/util.lisp Log: Pre-compute string length Enhanced condition hierarchy
Passes tests on LW
Modified: branches/edi/conditions.lisp ============================================================================== --- branches/edi/conditions.lisp (original) +++ branches/edi/conditions.lisp Sat May 24 23:14:26 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.7 2008/05/21 00:05:42 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.8 2008/05/25 03:07:58 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -82,22 +82,32 @@ (:documentation "Errors of this type are signalled if an erroneous position spec is used in conjunction with FILE-POSITION."))
-(define-condition external-format-error () +(define-condition external-format-condition (simple-condition) ((external-format :initarg :external-format :initform nil - :reader external-format-error-external-format)) + :reader external-format-condition-external-format)) + (:documentation "Superclass for all conditions related to external +formats.")) + +(define-condition external-format-error (external-format-condition error) + () (:documentation "Superclass for all errors related to external formats."))
-(define-condition external-format-simple-error (external-format-error simple-condition) +(define-condition external-format-warning (external-format-condition warning) () - (:documentation "Like EXTERNAL-FORMAT-ERROR but with formatting -capabilities.")) + (:documentation "Superclass for all warnings related to external +formats."))
-(define-condition external-format-encoding-error (external-format-simple-error) +(define-condition external-format-encoding-error (external-format-error) () (:documentation "Errors of this type are signalled if there is an encoding problem.")) + +(define-condition external-format-encoding-warning (external-format-warning) + () + (:documentation "Warnings of this type are signalled if there is an +encoding problem."))
(defun signal-encoding-error (external-format format-control &rest format-args) "Convenience function similar to ERROR to signal conditions of type @@ -106,3 +116,11 @@ :format-control format-control :format-arguments format-args :external-format external-format)) + +(defun signal-encoding-warning (external-format format-control &rest format-args) + "Convenience function similar to WARN to signal conditions of type +EXTERNAL-FORMAT-ENCODING-WARNING." + (warn 'external-format-encoding-warning + :format-control format-control + :format-arguments format-args + :external-format external-format))
Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Sat May 24 23:14:26 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.18 2008/05/25 01:42:50 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.19 2008/05/25 03:07:59 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -29,23 +29,26 @@
(in-package :flexi-streams)
-(defgeneric compute-number-of-chars (format sequence start end) +(defgeneric compute-number-of-chars (format sequence start end warnp) (declare #.*standard-optimize-settings*) (:documentation "Computes the exact number of characters required to decode the sequence of octets in SEQUENCE from START to END using the -external format FORMAT.")) +external format FORMAT. If WARNP is NIL, warnings will be muffled."))
-(defmethod compute-number-of-chars :around (format (list list) start end) +(defmethod compute-number-of-chars :around (format (list list) start end warnp) (declare #.*standard-optimize-settings*) - (call-next-method format (coerce list 'vector) start end)) + (call-next-method format (coerce list 'vector) start end warnp))
-(defmethod compute-number-of-chars ((format flexi-8-bit-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-8-bit-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (declare (ignore sequence)) (- end start))
-(defmethod compute-number-of-chars ((format flexi-crlf-8-bit-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-crlf-mixin) sequence start end warnp) + ;; this method only applies to the 8-bit formats as all other + ;; formats with CRLF line endings have their own specialized methods + ;; below (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((i start) @@ -61,18 +64,23 @@ (decf length))) length))
-(defun check-end (format start end i) +(defgeneric check-end (format start end i warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end i)) - (unless (= i end) - (signal-encoding-error format "These ~A octet~:P can't be ~ -decoded using ~A as the sequence is too short. ~A octet~:P ~ -missing at then end." - (- end start) - (external-format-name format) - (- i end)))) + (:method (format start end i warnp) + (when (and warnp (> i end)) + (signal-encoding-warning format "These ~A octet~:P can't be ~ +decoded using ~A as the sequence is too short. ~A octet~:P missing ~ +at then end." + (- end start) + (external-format-name format) + (- i end)))) + (:method ((format flexi-utf-16-format) start end i warnp) + ;; don't warn twice + (when (evenp (- end start)) + (call-next-method))))
-(defmethod compute-number-of-chars ((format flexi-utf-8-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-utf-8-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((sum 0) @@ -89,10 +97,10 @@ (declare (fixnum length) (octet octet)) (incf sum) (incf i length))) - (check-end format start end i) + (check-end format start end i warnp) sum))
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-8-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-crlf-utf-8-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((sum 0) @@ -112,25 +120,26 @@ (incf sum)) (incf i length) (setq last-octet octet))) - (check-end format start end i) + (check-end format start end i warnp) sum))
-(defmethod compute-number-of-chars :before ((format flexi-utf-16-format) sequence start end) +(defmethod compute-number-of-chars :before ((format flexi-utf-16-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) - (unless (evenp (- end start)) - (signal-encoding-error format "~A octet~:P cannot be decoded using ~ -UTF-16 as ~:*~A is not even." - (- end start)))) + (when (and warnp (oddp (- end start))) + (signal-encoding-warning format "~A octet~:P cannot be decoded ~ +using UTF-16 as ~:*~A is not even." + (- end start))))
-(defmethod compute-number-of-chars ((format flexi-utf-16-le-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-utf-16-le-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((sum 0) (i start)) (declare (fixnum i sum)) + (decf end 2) (loop - (when (>= i end) + (when (> i end) (return)) (let* ((high-octet (aref sequence (1+ i))) (length (cond ((<= #xd8 high-octet #xdf) 4) @@ -138,17 +147,18 @@ (declare (fixnum length) (octet high-octet)) (incf sum) (incf i length))) - (check-end format start end i) + (check-end format start (+ end 2) i warnp) sum))
-(defmethod compute-number-of-chars ((format flexi-utf-16-be-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-utf-16-be-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((sum 0) (i start)) (declare (fixnum i sum)) + (decf end 2) (loop - (when (>= i end) + (when (> i end) (return)) (let* ((high-octet (aref sequence i)) (length (cond ((<= #xd8 high-octet #xdf) 4) @@ -156,18 +166,19 @@ (declare (fixnum length) (octet high-octet)) (incf sum) (incf i length))) - (check-end format start end i) + (check-end format start (+ end 2) i warnp) sum))
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-16-le-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-crlf-utf-16-le-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((sum 0) (i start) (last-octet 0)) (declare (fixnum i sum) (octet last-octet)) + (decf end 2) (loop - (when (>= i end) + (when (> i end) (return)) (let* ((high-octet (aref sequence (1+ i))) (length (cond ((<= #xd8 high-octet #xdf) 4) @@ -175,24 +186,25 @@ (declare (fixnum length) (octet high-octet)) (unless (and (zerop high-octet) (= (the octet (aref sequence i)) +lf+) - (= last-octet +cr+)) + (= last-octet +cr+)) (incf sum)) - (incf i length) (setq last-octet (if (zerop high-octet) (aref sequence i) - 0)))) - (check-end format start end i) + 0)) + (incf i length))) + (check-end format start (+ end 2) i warnp) sum))
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-16-be-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-crlf-utf-16-be-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((sum 0) (i start) (last-octet 0)) (declare (fixnum i sum) (octet last-octet)) + (decf end 2) (loop - (when (>= i end) + (when (> i end) (return)) (let* ((high-octet (aref sequence i)) (length (cond ((<= #xd8 high-octet #xdf) 4) @@ -202,32 +214,33 @@ (= (the octet (aref sequence (1+ i))) +lf+) (= last-octet +cr+)) (incf sum)) - (incf i length) (setq last-octet (if (zerop high-octet) (aref sequence (1+ i)) - 0)))) - (check-end format start end i) + 0)) + (incf i length))) + (check-end format start (+ end 2) i warnp) sum)) -(defmethod compute-number-of-chars :before ((format flexi-utf-32-format) sequence start end) + +(defmethod compute-number-of-chars :before ((format flexi-utf-32-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((length (- end start))) - (unless (zerop (mod length 4)) - (signal-encoding-error format "~A octet~:P cannot be decoded using ~ -UTF-32 as ~:*~A is not a multiple-value of four." - length)))) + (when (and warnp (plusp (mod length 4))) + (signal-encoding-warning format "~A octet~:P cannot be decoded ~ +using UTF-32 as ~:*~A is not a multiple-value of four." + length))))
-(defmethod compute-number-of-chars ((format flexi-utf-32-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-utf-32-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (declare (ignore sequence)) - (/ (- end start) 4)) + (ceiling (- end start) 4))
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-32-le-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-crlf-utf-32-le-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((i start) - (length (/ (- end start) 4))) + (length (ceiling (- end start) 4))) (decf end 8) (loop (when (> i end) @@ -240,11 +253,11 @@ (t (incf i 4)))) length))
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-32-be-format) sequence start end) +(defmethod compute-number-of-chars ((format flexi-crlf-utf-32-be-format) sequence start end warnp) (declare #.*fixnum-optimize-settings*) (declare (fixnum start end)) (let ((i start) - (length (/ (- end start) 4))) + (length (ceiling (- end start) 4))) (decf end 8) (loop (when (> i end)
Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Sat May 24 23:14:26 2008 @@ -69,7 +69,12 @@ <li><a href="#external-format-equal"><code>external-format-equal</code></a> <li><a href="#*default-eol-style*"><code>*default-eol-style*</code></a> <li><a href="#*default-little-endian*"><code>*default-little-endian*</code></a> + <li><a href="#external-format-condition"><code>external-format-condition</code></a> + <li><a href="#external-format-condition-external-format"><code>external-format-condition-external-format</code></a> + <li><a href="#external-format-error"><code>external-format-error</code></a> + <li><a href="#external-format-warning"><code>external-format-warning</code></a> <li><a href="#external-format-encoding-error"><code>external-format-encoding-error</code></a> + <li><a href="#*substitution-char*"><code>*substitution-char*</code></a> </ol> <li><a href="#flexi-streams">Flexi streams</a> <ol> @@ -86,7 +91,6 @@ <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="#*substitution-char*"><code>*substitution-char*</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-out-of-sync-error"><code>flexi-stream-out-of-sync-error</code></a> @@ -526,29 +530,98 @@ </blockquote>
<p><br>[Condition] -<br><a class=none name="external-format-error"><b>external-format-error</b></a> +<br><a class=none name="external-format-condition"><b>external-format-condition</b></a>
<blockquote><br> -All errors related to <a href="#external-formats">external formats</a> are of this type. -There's a slot for the external format which can be accessed with <a href="#external-format-error-external-format"><code>EXTERNAL-FORMAT-ERROR-EXTERNAL-FORMAT</code></a>. +All conditions related to <a href="#external-formats">external formats</a> are of this type. +There's a slot for the external format which can be accessed with <a href="#external-format-condition-external-format"><code>EXTERNAL-FORMAT-CONDITION-EXTERNAL-FORMAT</code></a>. </blockquote>
<p><br>[Reader] -<br><a class=none name="external-format-error-external-format"><b>external-format-error-external-format</b> <i>condition</i> => <i>external-format</i></a> +<br><a class=none name="external-format-condition-external-format"><b>external-format-condition-external-format</b> <i>condition</i> => <i>external-format</i></a>
<blockquote><br> If <code><i>condition</i></code> is of -type <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>, +type <a href="#external-format-condition"><code>EXTERNAL-FORMAT-CONDITION</code></a>, this function will return the associated external format. Note that -there are errors which happen during the creation of external formats -where this method returns <code>NIL</code>. +there are situation which happen during the creation of external +formats where this method returns <code>NIL</code>. +</blockquote> + +<p><br>[Condition] +<br><a class=none name="external-format-warning"><b>external-format-warning</b></a> + +<blockquote><br> +All warnings related to <a href="#external-formats">external formats</a> are of this type. +This is a subtype of <a href="#external-format-condition"><code>EXTERNAL-FORMAT-CONDITION</code></a>. +</blockquote> + +<p><br>[Condition] +<br><a class=none name="external-format-error"><b>external-format-error</b></a> + +<blockquote><br> +All errors related to <a href="#external-formats">external formats</a> are of this type. +This is a subtype of <a href="#external-format-condition"><code>EXTERNAL-FORMAT-CONDITION</code></a>. </blockquote>
<p><br>[Condition] <br><a class=none name="external-format-encoding-error"><b>external-format-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.) When this condition is signalled 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="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> is a subtype of <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>. +All errors related to encoding problems with <a href="#external-formats">external formats</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 signalled 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 the example for it. <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> is a subtype of <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>. +</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="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> would have been signalled otherwise. + +<pre> +CL-USER 1 > (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 > (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 <option number> to proceed, or :? for other options + +CL-USER 3 : 1 > :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 <option number> to proceed, or :? for other options + +CL-USER 4 : 1 > :c +Type a character: y +"xy" +T + +CL-USER 5 > (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#external-format-encoding-error" class=noborder>external-format-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 6 > (let ((<a href="#*SUBSTITUTION-CHAR*" class=noborder>*substitution-char*</a> #?)) + (foo)) +"??" +T +</pre> </blockquote>
<h4><a name="flexi-streams" class=none>Flexi streams</a></h4> @@ -739,59 +812,6 @@ 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="*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="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> would have been signalled otherwise. - -<pre> -CL-USER 1 > (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 > (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 <option number> to proceed, or :? for other options - -CL-USER 3 : 1 > :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 <option number> to proceed, or :? for other options - -CL-USER 4 : 1 > :c -Type a character: y -"xy" -T - -CL-USER 5 > (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#external-format-encoding-error" class=noborder>external-format-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 6 > (let ((<a href="#*SUBSTITUTION-CHAR*" class=noborder>*substitution-char*</a> #?)) - (foo)) -"??" -T -</pre> -</blockquote> - <p><br>[Type] <br><a class=none name="octet"><b>octet</b></a>
@@ -997,7 +1017,7 @@
<blockquote><br> Converts the Lisp sequence <code><i>sequence</i></code> of <a href="#octet">octets</a> -from <code><i>start</i></code> to <code><i>end</i></code> to string +from <code><i>start</i></code> to <code><i>end</i></code> to a string using the <a href="#external-formats">external format</a> designated by <code><i>external-format</i></code>. The defaults for <code><i>start</i></code> and <code><i>end</i></code> @@ -1075,7 +1095,7 @@ his work on making FLEXI-STREAMS faster.
<p> -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.112 2008/05/25 01:41:25 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.114 2008/05/25 03:08:01 edi Exp $ <p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
</body>
Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Sat May 24 23:14:26 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.75 2008/05/23 14:43:09 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.76 2008/05/25 03:07:59 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -354,10 +354,10 @@ (with-accessors ((last-char-code flexi-stream-last-char-code)) stream (unless last-char-code - (error 'flexi-stream-simple-error + (error 'flexi-stream-error :format-control "No character to unread from this stream (or external format has changed or last reading operation was binary).")) (unless (= (char-code char) last-char-code) - (error 'flexi-stream-simple-error + (error 'flexi-stream-error :format-control "Last character read (~S) was different from ~S." :format-arguments (list (code-char last-char-code) char))) (unread-char% char stream) @@ -374,10 +374,10 @@ (position flexi-stream-position)) flexi-input-stream (unless last-octet - (error 'flexi-stream-simple-error + (error 'flexi-stream-error :format-control "No byte to unread from this stream (or last reading operation read a character).")) (unless (= byte last-octet) - (error 'flexi-stream-simple-error + (error 'flexi-stream-error :format-control "Last byte read was different from #x~X." :format-arguments (list byte))) (setq last-octet nil)
Modified: branches/edi/packages.lisp ============================================================================== --- branches/edi/packages.lisp (original) +++ branches/edi/packages.lisp Sat May 24 23:14:26 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.36 2008/05/25 01:40:54 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.37 2008/05/25 03:07:59 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -41,14 +41,17 @@ :*default-little-endian* :*substitution-char* :char-length + :external-format-condition + :external-format-condition-external-format :external-format-eol-style :external-format-error - :external-format-error-external-format :external-format-encoding-error + :external-format-encoding-warning :external-format-equal :external-format-id :external-format-little-endian :external-format-name + :external-format-warning :flexi-input-stream :flexi-output-stream :flexi-io-stream
Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Sat May 24 23:14:26 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.26 2008/05/25 01:41:32 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.28 2008/05/25 03:07:59 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -45,13 +45,11 @@ (external-format :latin1) (start 0) (end (length sequence))) "Converts the Lisp sequence SEQUENCE of octets from START to END to -string using the external format designated by EXTERNAL-FORMAT." +a string using the external format designated by EXTERNAL-FORMAT." (declare #.*standard-optimize-settings*) (declare (fixnum start end)) (setq external-format (maybe-convert-external-format external-format)) - (let* ((factor (encoding-factor external-format)) - (length (- end start)) - (i start) + (let* ((i start) (reader (etypecase sequence ((array octet *) (lambda () @@ -82,37 +80,12 @@ (flet ((next-char () (code-char (octets-to-char-code external-format reader)))) (declare (inline next-char)) - (etypecase factor - (integer - (let* ((string-length (ceiling length factor)) - (string (make-array string-length - :element-type 'char*))) - (declare (fixnum string-length)) - (loop for j of-type fixnum from 0 below string-length - do (setf (schar string j) (next-char)) - finally (return string)))) - (double-float - ;; this is a bit clunky but hopefully a bit more efficient than - ;; using VECTOR-PUSH-EXTEND - (let* ((string-length (ceiling length (the double-float factor))) - (string (make-array string-length - :element-type 'char* - :fill-pointer t - :adjustable t)) - (j 0)) - (declare (fixnum j string-length) - (double-float factor)) - (loop - (when (>= i end) - (return)) - (when (>= j string-length) - (setq factor (/ factor 2.0d0)) - (incf string-length (the fixnum (ceiling (- end i) factor))) - (adjust-array string string-length :fill-pointer t)) - (setf (char string j) (next-char)) - (incf j)) - (setf (fill-pointer string) j) - string)))))))) + (let* ((string-length (compute-number-of-chars external-format sequence start end nil)) + (string (make-array string-length :element-type 'char*))) + (declare (fixnum string-length)) + (loop for j of-type fixnum from 0 below string-length + do (setf (schar string j) (next-char)) + finally (return string))))))))
(defun octet-length (string &key (external-format :latin1) (start 0) (end (length string))) "Returns the length of the substring of STRING from START to END in @@ -129,4 +102,4 @@ (declare #.*standard-optimize-settings*) (declare (fixnum start end) (string string)) (setq external-format (maybe-convert-external-format external-format)) - (compute-number-of-chars external-format sequence start end)) + (compute-number-of-chars external-format sequence start end t))
Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Sat May 24 23:14:26 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.32 2008/05/21 17:51:42 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.33 2008/05/25 03:08:02 edi Exp $
;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
@@ -264,8 +264,8 @@ `(handler-case (unless ,expression (fail "Expression ~S failed.~%" ',expression)) - (condition (c) - (fail "Expression ~S failed signaling condition of type ~A: ~A.~%" + (error (c) + (fail "Expression ~S failed signalling error of type ~A: ~A.~%" ',expression (type-of c) c))))) (format *error-output* "Test ~S~%" ,test-description) ,@body @@ -473,10 +473,10 @@ (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))) - (check (string= "??" (read-flexi-line* #(#xe4 #xf6 #xfc) :utf8))) + (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))) - (check (string= "??" (read-flexi-line* #(#b11111110 #b11111111) :utf8)))) + (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) @@ -490,13 +490,13 @@ (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)))) - (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line* #(#xe4 #xf6 #xfc) :utf8)))) + (check (string= "Q" (using-values (#\Q) (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)))) - (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line* #(#b11111110 #b11111111) :utf8)))) + (check (string= "Q" (using-values (#\Q) (read-flexi-line* #(#b11111110 #b11111111) :utf8)))) ;; only one byte (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16le)))) - (check (string= "E" (using-values (#\E) (read-flexi-line* #(#x01) :utf-16le)))) + (check (string= "" (read-flexi-line* #(#x01) :utf-16le))) ;; two bytes, but value of resulting word suggests that another word follows (check (string= "R" (using-values (#\R) (read-flexi-line '(#x01 #xd8) :utf-16le)))) (check (string= "R" (using-values (#\R) (read-flexi-line* #(#x01 #xd8) :utf-16le)))) @@ -507,7 +507,7 @@ (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)))) - (check (string= "E" (using-values (#\E) (read-flexi-line* #(#x01) :utf-16be)))) + (check (string= "" (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 signalled for UTF-32 is at end of file
Modified: branches/edi/util.lisp ============================================================================== --- branches/edi/util.lisp (original) +++ branches/edi/util.lisp Sat May 24 23:14:26 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.22 2008/05/25 01:40:54 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.23 2008/05/25 03:07:59 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -115,7 +115,7 @@ (unless (find real-name +name-map+ :test #'eq :key #'cdr) - (error 'external-format-simple-error + (error 'external-format-error :format-control "~S is not known to be a name for an external format." :format-arguments (list name))) real-name))