[flexi-streams-cvs] r55 - in branches/edi: . doc test
eweitz at common-lisp.net
eweitz at common-lisp.net
Sun May 25 03:14:27 UTC 2008
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)
, at 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))
More information about the Flexi-streams-cvs
mailing list