May 2008 - flexi-streams-cvs@common-lisp.net

[flexi-streams-cvs] r41 - in branches/edi: . doc
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Tue May 20 21:18:58 2008 New Revision: 41 Modified: branches/edi/CHANGELOG branches/edi/doc/index.html branches/edi/output.lisp Log: write-sequence Modified: branches/edi/CHANGELOG ============================================================================== --- branches/edi/CHANGELOG (original) +++ branches/edi/CHANGELOG Tue May 20 21:18:58 2008 @@ -1,3 +1,5 @@ +Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans H�bner) + Version 0.14.0 2007-12-30 Some fixes for LispWorks (when the underlying stream is a character stream) Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Tue May 20 21:18:58 2008 @@ -1037,10 +1037,12 @@ Thanks to David Lichteblau for numerous portability patches. Thanks to Igor Plekhov for the KOI8-R code. Thanks to Anton Vodonosov for -numerous patches and additions. +numerous patches and additions. Thanks +to <a href="http://netzhansa.blogspot.com/">Hans Hübner</a> for +his work on making FLEXI-STREAMS faster. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.105 2008/05/20 23:44:47 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.106 2008/05/21 01:06:45 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Tue May 20 21:18:58 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.57 2008/05/21 00:04:58 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.59 2008/05/21 01:17:45 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -129,66 +129,71 @@ ;; needed for AllegroCL - grrr... (stream-write-char stream #\Newline)) -(defmethod stream-write-sequence ((flexi-output-stream flexi-output-stream) sequence start end &key) - "Writes all elements of the sequence SEQUENCE from START to END -to the underlying stream. The elements can be either octets or -characters. Characters are output according to the current -encoding \(external format) of the FLEXI-OUTPUT-STREAM object -STREAM." - (declare #.*standard-optimize-settings*) +(defmethod stream-write-sequence ((stream flexi-output-stream) sequence start end &key) +; (declare #.*standard-optimize-settings*) (declare (fixnum start end)) - (with-accessors ((stream flexi-stream-stream) - (column flexi-stream-column)) - flexi-output-stream - (cond ((and (arrayp sequence) - (subtypep (array-element-type sequence) 'octet)) - ;; set column to NIL because we don't know how to handle binary - ;; output mixed with character output - (setq column nil) - (write-sequence sequence stream :start start :end end)) - (t (loop for index from start below end - for element = (elt sequence index) - when (characterp element) do - (stream-write-char flexi-output-stream element) - else do - (stream-write-byte flexi-output-stream element)) - sequence)))) - -(defmethod stream-write-sequence ((stream flexi-output-stream) (sequence string) start end &key) - "Optimized method for the cases where SEQUENCE is a string. Fills -an internal buffer and uses repeated calls to WRITE-SEQUENCE to write -to the underlying stream." - (declare #.*standard-optimize-settings*) - (declare (fixnum start end)) - ;; don't use this optimized method for bivalent character streams on - ;; LispWorks, as it currently gets confused by the fill pointer - #+:lispworks - (unless (typep stream 'flexi-binary-output-stream) - (return-from stream-write-sequence - (call-next-method))) - (let ((buffer (make-array (+ +buffer-size+ 20) - :element-type 'octet - :fill-pointer 0)) - (last-newline-pos (position #\Newline sequence - :test #'char= - :start start - :end end - :from-end t))) - (loop with format = (flexi-stream-external-format stream) - for index from start below end - do (char-to-octets format - (aref sequence index) - (lambda (octet) - (vector-push octet buffer))) - when (>= (fill-pointer buffer) +buffer-size+) do - (write-sequence buffer (flexi-stream-stream stream)) - (setf (fill-pointer buffer) 0) - finally (when (>= (fill-pointer buffer) 0) - (write-sequence buffer (flexi-stream-stream stream)))) - (setf (flexi-stream-column stream) - (cond (last-newline-pos (- end last-newline-pos 1)) - ((flexi-stream-column stream) - (+ (flexi-stream-column stream) (- end start)))))) + (with-accessors ((column flexi-stream-column) + (external-format flexi-stream-external-format) + (stream flexi-stream-stream)) + stream + (let* ((octet-seen-p nil) + (buffer-pos 0) + ;; whether we might receive characters and thus the number + ;; of octets to output might not be equal to the number of + ;; sequence elements to write + (chars-p (or (listp sequence) + (and (vectorp sequence) + (not (subtypep (array-element-type sequence) 'integer))))) + (factor (if chars-p (encoding-factor external-format) 1)) + (buffer-size (min +buffer-size+ (ceiling (* factor (- end start))))) + (buffer (make-octet-buffer buffer-size))) + (declare (fixnum buffer-pos buffer-size) + (boolean octet-seen-p) + (type (array octet *) buffer)) + (labels ((flush-buffer () + (write-sequence buffer stream :end buffer-pos) + (setq buffer-pos 0)) + (write-octet (octet) + (declare (octet octet)) + (when (>= buffer-pos buffer-size) + (flush-buffer)) + (setf (aref buffer buffer-pos) octet) + (incf buffer-pos)) + (write-character (char) + (char-to-octets external-format char #'write-octet)) + (write-object (object) + (etypecase object + (octet (setq octet-seen-p t) + (write-octet object)) + (character (write-character object))))) + (declare (dynamic-extent (function write-octet))) + (macrolet ((iterate (octets-p output-form) + `(progn + ,@(if octets-p '((setq octet-seen-p t))) + (loop for index of-type fixnum from start below end + do ,output-form + finally (when (plusp buffer-pos) + (flush-buffer)))))) + (etypecase sequence + (string (iterate nil (write-character (char sequence index)))) + (array + (let ((array-element-type (array-element-type sequence))) + (cond ((type-equal array-element-type 'octet) + (iterate t (write-octet (aref (the (array octet *) sequence) index)))) + ((subtypep array-element-type 'integer) + (iterate t (write-octet (aref sequence index)))) + (t (iterate nil (write-object (aref sequence index))))))) + (list (iterate nil (write-object (nth index sequence))))) + (setq column + (cond (octet-seen-p nil) + (t (let ((last-newline-pos (position #\Newline sequence + :test #'char= + :start start + :end end + :from-end t))) + (cond (last-newline-pos (- end last-newline-pos 1)) + (column (+ column (- end start)))))))))))) + sequence) (defmethod stream-write-string ((stream flexi-output-stream) string

1 0

[flexi-streams-cvs] r40 - branches/edi
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Tue May 20 20:19:12 2008 New Revision: 40 Modified: branches/edi/conditions.lisp branches/edi/input.lisp branches/edi/output.lisp Log: read-sequence slightly improved for file streams Modified: branches/edi/conditions.lisp ============================================================================== --- branches/edi/conditions.lisp (original) +++ branches/edi/conditions.lisp Tue May 20 20:19:12 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.6 2008/05/20 23:44:45 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.7 2008/05/21 00:05:42 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -51,6 +51,7 @@ (define-condition flexi-stream-out-of-sync-error (flexi-stream-error) () (:report (lambda (condition stream) + (declare (ignore condition)) (format stream "Stream out of sync from previous lookahead, couldn't rewind."))) (:documentation "This can happen if you're trying to write to an IO Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Tue May 20 20:19:12 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.68 2008/05/20 23:01:51 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.70 2008/05/21 00:18:35 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -217,23 +217,32 @@ (buffer-pos 0) (buffer-end 0) (index start) + ;; whether we will deliver characters and thus the number + ;; of octets to read might not be equal to the number of + ;; sequence elements to fill (want-chars-p (or (stringp sequence) (and (vectorp sequence) (not (subtypep (array-element-type sequence) 'integer))) - (type-equal element-type 'octet))) + (not (type-equal element-type 'octet)))) + ;; whether we will later be able to rewind the stream if + ;; needed (to get rid of unused octets in the buffer) + (can-rewind-p (and want-chars-p (maybe-rewind stream 0))) (factor (if want-chars-p (encoding-factor external-format) 1)) (integer-factor (floor factor)) ;; it's an interesting question whether it makes sense ;; performance-wise to make RESERVE significantly bigger ;; (and thus put potentially a lot more octets into ;; OCTET-STACK), especially for UTF-8 - (reserve (if (floatp factor) (* 2 integer-factor) 0))) + (reserve (cond ((not (floatp factor)) 0) + ((not can-rewind-p) (* 2 integer-factor)) + (t (ceiling (* (- factor integer-factor) (- end start))))))) (declare (fixnum buffer-pos buffer-end index integer-factor reserve) - (boolean want-chars-p)) - (flet ((compute-minimum () - "Computes the minimum amount of octets we can savely -read into the buffer without violating the stream's bound \(if there -is one) and without potentially reading much more than we need." + (boolean want-chars-p can-rewind-p)) + (flet ((compute-fill-amount () + "Computes the amount of octets we can savely read into +the buffer without violating the stream's bound \(if there is one) and +without potentially reading much more than we need \(unless we can +rewind afterwards)." (let ((minimum (min (the fixnum (+ (the fixnum (* integer-factor (the fixnum (- end index)))) reserve)) @@ -261,7 +270,7 @@ ;; compare with BUFFER-POS (unless (zerop buffer-end) (incf position buffer-end)))) - (let ((minimum (compute-minimum))) + (let ((minimum (compute-fill-amount))) (declare (fixnum minimum)) (setq buffer (make-octet-buffer minimum)) ;; fill buffer for the first time or return immediately if @@ -275,7 +284,7 @@ stream." (when (>= buffer-pos buffer-end) (setq buffer-pos 0) - (unless (fill-buffer (compute-minimum)) + (unless (fill-buffer (compute-fill-amount)) (return-from next-octet))) (prog1 (aref (the (array octet *) buffer) buffer-pos) @@ -306,12 +315,17 @@ (when (>= index end) ;; check if there are octets in the ;; buffer we didn't use - see - ;; COMPUTE-MINIMUM above - (loop - (when (>= buffer-pos buffer-end) - (return)) - (decf buffer-end) - (push (aref (the (array octet *) buffer) buffer-end) octet-stack)) + ;; COMPUTE-FILL-AMOUNT above + (let ((rest (- buffer-end buffer-pos))) + (when (plusp rest) + (or (and can-rewind-p + (maybe-rewind stream rest)) + (loop + (when (>= buffer-pos buffer-end) + (return)) + (decf buffer-end) + (push (aref (the (array octet *) buffer) buffer-end) + octet-stack))))) (leave)) (let ((next-thing ,(if octetp '(next-octet) Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Tue May 20 20:19:12 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.56 2008/05/20 23:44:45 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.57 2008/05/21 00:04:58 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -129,19 +129,6 @@ ;; needed for AllegroCL - grrr... (stream-write-char stream #\Newline)) -;; TODO: file-position -> octet-stack (and others?) - -;; other way around: function "resync" trying to use File-position? - -;; "resync" independent function to empty octet-stack? -;; (decrement-file-position) => success -;; (resync ... &optional how-much (length octet-stack)) => success - -;; in stream-read-sequence: if file stream, read more into buffer, -;; then resync with file-position? - -;; TODO: interaction between read and write - (defmethod stream-write-sequence ((flexi-output-stream flexi-output-stream) sequence start end &key) "Writes all elements of the sequence SEQUENCE from START to END to the underlying stream. The elements can be either octets or

1 0

[flexi-streams-cvs] r39 - branches/edi
by eweitz＠common-lisp.net 20 May '08

20 May '08

Author: eweitz Date: Tue May 20 19:46:57 2008 New Revision: 39 Added: branches/edi/io.lisp (contents, props changed) Log: Forgot one... Added: branches/edi/io.lisp ============================================================================== --- (empty file) +++ branches/edi/io.lisp Tue May 20 19:46:57 2008 @@ -0,0 +1,110 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/io.lisp,v 1.2 2008/05/20 23:44:45 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(defmethod reset-input-state ((flexi-io-stream flexi-io-stream)) + "This method is used to clear any state associated with previous +input before output is attempted on the stream. It can fail if the +octet stack is not empty and the stream can't be `rewound'." + (declare #.*standard-optimize-settings*) + (with-accessors ((last-char-code flexi-stream-last-char-code) + (last-octet flexi-stream-last-octet) + (octet-stack flexi-stream-octet-stack) + (stream flexi-stream-stream)) + flexi-io-stream + (when octet-stack + (unless (maybe-rewind stream (length octet-stack)) + (error 'flexi-stream-out-of-sync-error + :stream flexi-io-stream)) + (setq octet-stack nil)) + (setq last-octet nil + last-char-code nil))) + +(defmethod stream-write-byte :before ((stream flexi-io-stream) byte) + (declare #.*standard-optimize-settings*) + (declare (ignore byte)) + (reset-input-state stream)) + +(defmethod stream-write-char :before ((stream flexi-io-stream) char) + (declare #.*standard-optimize-settings*) + (declare (ignore char)) + (reset-input-state stream)) + +(defmethod stream-write-sequence :before ((stream flexi-io-stream) sequence start end &key) + (declare #.*standard-optimize-settings*) + (declare (ignore sequence start end)) + (reset-input-state stream)) + +(defmethod stream-clear-output :before ((stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (reset-input-state stream)) + +(defmethod reset-output-state ((flexi-io-stream flexi-io-stream)) + "This method is used to clear any state associated with previous +output before the stream is used for input." + (declare #.*standard-optimize-settings*) + (with-accessors ((column flexi-stream-column)) + flexi-io-stream + (setq column nil))) + +(defmethod stream-read-byte :before ((stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (reset-output-state stream)) + +(defmethod stream-read-char :before ((stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (reset-output-state stream)) + +(defmethod stream-read-sequence :before ((stream flexi-io-stream) sequence start end &key) + (declare #.*standard-optimize-settings*) + (declare (ignore sequence start end)) + (reset-output-state stream)) + +(defmethod stream-unread-char :before ((stream flexi-io-stream) char) + (declare #.*standard-optimize-settings*) + (declare (ignore char)) + (reset-output-state stream)) + +(defmethod unread-byte :before (byte (stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (declare (ignore byte)) + (reset-output-state stream)) + +(defmethod stream-clear-input :before ((stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (reset-output-state stream)) + +(defmethod write-byte* :after (byte (stream flexi-io-stream)) + "Keep POSITION slot up to date even when performing output." + (declare #.*standard-optimize-settings*) + (declare (ignore byte)) + (with-accessors ((position flexi-stream-position)) + stream + (incf position))) \ No newline at end of file

1 0

[flexi-streams-cvs] r38 - in branches/edi: . doc test
by eweitz＠common-lisp.net 20 May '08

20 May '08

Author: eweitz Date: Tue May 20 19:45:25 2008 New Revision: 38 Modified: branches/edi/conditions.lisp branches/edi/decode.lisp branches/edi/doc/index.html branches/edi/encode.lisp branches/edi/external-format.lisp branches/edi/flexi-streams.asd branches/edi/input.lisp branches/edi/mapping.lisp branches/edi/output.lisp branches/edi/packages.lisp branches/edi/specials.lisp branches/edi/test/test.lisp branches/edi/util.lisp Log: IO stream cleanup Modified: branches/edi/conditions.lisp ============================================================================== --- branches/edi/conditions.lisp (original) +++ branches/edi/conditions.lisp Tue May 20 19:45:25 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.5 2008/05/19 07:57:07 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.6 2008/05/20 23:44:45 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -48,6 +48,15 @@ (:documentation "Errors of this type are signalled if the flexi stream has a wrong element type.")) +(define-condition flexi-stream-out-of-sync-error (flexi-stream-error) + () + (:report (lambda (condition stream) + (format stream "Stream out of sync from previous +lookahead, couldn't rewind."))) + (:documentation "This can happen if you're trying to write to an IO +stream which had prior to that `looked ahead' while reading and now +can't `rewind' to the octet where you /should/ be.")) + (define-condition in-memory-stream-error (stream-error) () (:documentation "Superclass for all errors related to Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Tue May 20 19:45:25 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.15 2008/05/20 09:37:43 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.16 2008/05/20 23:01:50 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -61,12 +61,12 @@ whenever this function is called.")) (defmethod octets-to-char-code ((format flexi-latin-1-format) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function reader)) (funcall reader)) (defmethod octets-to-char-code ((format flexi-ascii-format) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function reader)) (when-let (octet (funcall reader)) (if (> (the octet octet) 127) @@ -75,7 +75,7 @@ octet))) (defmethod octets-to-char-code ((format flexi-8-bit-format) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function reader)) (with-accessors ((decoding-table external-format-decoding-table)) format @@ -89,7 +89,7 @@ char-code))))) (defmethod octets-to-char-code ((format flexi-utf-8-format) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function reader)) (let (first-octet-seen) (declare (boolean first-octet-seen)) @@ -105,7 +105,7 @@ (let ((octet (read-next-byte))) (declare (type octet octet)) (multiple-value-bind (start count) - (cond ((zerop (logand octet #b10000000)) + (cond ((not (logbitp 7 octet)) (values octet 0)) ((= #b11000000 (logand octet #b11100000)) (values (logand octet #b00011111) 1)) @@ -124,8 +124,8 @@ (declare (fixnum count)) ;; 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 (the (unsigned-byte 26) result) 6) + (loop for result of-type code-point + = start then (+ (ash result 6) (logand octet #b111111)) repeat count for octet of-type octet = (read-next-byte) @@ -136,7 +136,7 @@ finally (return result))))))) (defmethod octets-to-char-code ((format flexi-utf-16-le-format) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function reader)) (let (first-octet-seen) (declare (boolean first-octet-seen)) @@ -169,7 +169,7 @@ (t word))))))) (defmethod octets-to-char-code ((format flexi-utf-16-be-format) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function reader)) (let (first-octet-seen) (declare (boolean first-octet-seen)) @@ -202,7 +202,7 @@ (t word))))))) (defmethod octets-to-char-code ((format flexi-utf-32-le-format) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function reader)) (let (first-octet-seen) (declare (boolean first-octet-seen)) @@ -220,7 +220,7 @@ sum (ash octet count))))) (defmethod octets-to-char-code ((format flexi-utf-32-be-format) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function reader)) (let (first-octet-seen) (declare (boolean first-octet-seen)) @@ -238,7 +238,7 @@ sum (ash octet count))))) (defmethod octets-to-char-code ((format flexi-cr-mixin) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (ignore reader)) (let ((char-code (call-next-method))) (case char-code @@ -246,7 +246,7 @@ (otherwise char-code)))) (defmethod octets-to-char-code ((format flexi-crlf-mixin) reader) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (function *current-unreader*)) (declare (ignore reader)) (let ((char-code (call-next-method))) Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Tue May 20 19:45:25 2008 @@ -89,6 +89,7 @@ <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> <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> </ol> @@ -804,6 +805,15 @@ </blockquote> [Condition] + <a class=none name="flexi-stream-out-of-sync-error">flexi-stream-out-of-sync-error</a> + +<blockquote> This can happen if you're trying to write to +an <a href="#flexi-io-stream">IO stream</a> which had prior to that +"looked ahead" while reading and now can't "rewind" to the octet where +you should be. +</blockquote> + + [Condition] <a class=none name="flexi-stream-element-type-error">flexi-stream-element-type-error</a> <blockquote> @@ -1030,7 +1040,7 @@ numerous patches and additions. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.104 2008/05/20 06:55:21 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.105 2008/05/20 23:44:47 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: branches/edi/encode.lisp ============================================================================== --- branches/edi/encode.lisp (original) +++ branches/edi/encode.lisp Tue May 20 19:45:25 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.11 2008/05/20 08:02:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.12 2008/05/20 23:01:50 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -38,7 +38,7 @@ unspecified.")) (defmethod char-to-octets ((format flexi-latin-1-format) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char) (function writer)) (let ((octet (char-code char))) (when (> octet 255) @@ -46,7 +46,7 @@ (funcall writer octet))) (defmethod char-to-octets ((format flexi-ascii-format) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char) (function writer)) (let ((octet (char-code char))) (when (> octet 127) @@ -54,7 +54,7 @@ (funcall writer octet))) (defmethod char-to-octets ((format flexi-8-bit-format) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char) (function writer)) (with-accessors ((encoding-hash external-format-encoding-hash)) format @@ -64,7 +64,7 @@ (funcall writer octet)))) (defmethod char-to-octets ((format flexi-utf-8-format) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char) (function writer)) (let ((char-code (char-code char))) (tagbody @@ -96,7 +96,7 @@ zero))) (defmethod char-to-octets ((format flexi-utf-16-le-format) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char) (function writer)) (flet ((write-word (word) (funcall writer (ldb (byte 8 0) word)) @@ -111,7 +111,7 @@ (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) (defmethod char-to-octets ((format flexi-utf-16-be-format) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char) (function writer)) (flet ((write-word (word) (funcall writer (ldb (byte 8 8) word)) @@ -126,7 +126,7 @@ (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) (defmethod char-to-octets ((format flexi-utf-32-le-format) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char) (function writer)) (let ((char-code (char-code char))) (funcall writer (ldb (byte 8 0) char-code)) @@ -135,7 +135,7 @@ (funcall writer (ldb (byte 8 24) char-code)))) (defmethod char-to-octets ((format flexi-utf-32-be-format) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char) (function writer)) (let ((char-code (char-code char))) (funcall writer (ldb (byte 8 24) char-code)) @@ -144,14 +144,14 @@ (funcall writer (ldb (byte 8 0) char-code)))) (defmethod char-to-octets ((format flexi-cr-mixin) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char)) (if (char= char #\Newline) (call-next-method format #\Return writer) (call-next-method))) (defmethod char-to-octets ((format flexi-crlf-mixin) char writer) - (declare #.*standard-optimize-settings*) + (declare #.*fixnum-optimize-settings*) (declare (character char)) (cond ((char= char #\Newline) (call-next-method format #\Return writer) Modified: branches/edi/external-format.lisp ============================================================================== --- branches/edi/external-format.lisp (original) +++ branches/edi/external-format.lisp Tue May 20 19:45:25 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.20 2008/05/20 08:02:50 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.21 2008/05/20 23:44:45 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -284,7 +284,7 @@ 'flexi-crlf-utf-32-be-format)))))))) (defun make-external-format% (name &key (little-endian *default-little-endian*) - id eol-style) + id eol-style) "Used internally by MAKE-EXTERNAL-FORMAT to default some of the keywords arguments and to determine the right subclass of EXTERNAL-FORMAT." @@ -297,7 +297,9 @@ (list :eol-style (or eol-style *default-eol-style*))) ((code-page-name-p real-name) (list :id (or (known-code-page-id-p id) - (error "Unknown code page ID ~S" id)) + (error 'external-format-error + :format-control "Unknown code page ID ~S" + :format-arguments (list id))) ;; default EOL style for Windows code pages is :CRLF :eol-style (or eol-style :crlf))) (t (list :eol-style (or eol-style *default-eol-style*) Modified: branches/edi/flexi-streams.asd ============================================================================== --- branches/edi/flexi-streams.asd (original) +++ branches/edi/flexi-streams.asd Tue May 20 19:45:25 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.63 2008/05/18 23:13:59 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.64 2008/05/20 23:01:51 edi Exp $ ;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. @@ -54,6 +54,7 @@ #+:lispworks (:file "lw-binary-stream") (:file "output") (:file "input") + (:file "io") (:file "strings")) :depends-on (:trivial-gray-streams)) Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Tue May 20 19:45:25 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.67 2008/05/20 09:38:07 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.68 2008/05/20 23:01:51 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -213,7 +213,7 @@ (element-type flexi-stream-element-type) (stream flexi-stream-stream)) flexi-input-stream - (let* ((buffer (make-octet-buffer)) + (let* (buffer (buffer-pos 0) (buffer-end 0) (index start) @@ -229,7 +229,7 @@ ;; OCTET-STACK), especially for UTF-8 (reserve (if (floatp factor) (* 2 integer-factor) 0))) (declare (fixnum buffer-pos buffer-end index integer-factor reserve) - (type (array octet *) buffer)) + (boolean want-chars-p)) (flet ((compute-minimum () "Computes the minimum amount of octets we can savely read into the buffer without violating the stream's bound \(if there @@ -243,6 +243,15 @@ (fill-buffer (end) "Tries to fill the buffer from BUFFER-POS to END and returns NIL if the buffer doesn't contain any new data." + ;; put data from octet stack into buffer if there is any + (loop + (when (>= buffer-pos end) + (return)) + (let ((next-octet (pop octet-stack))) + (cond (next-octet + (setf (aref (the (array octet *) buffer) buffer-pos) (the octet next-octet)) + (incf buffer-pos)) + (t (return))))) (setq buffer-end (read-sequence buffer stream :start buffer-pos :end end)) @@ -254,15 +263,7 @@ (incf position buffer-end)))) (let ((minimum (compute-minimum))) (declare (fixnum minimum)) - ;; put data from octet stack into buffer if there is any - (loop - (when (>= buffer-pos minimum) - (return)) - (let ((next-octet (pop octet-stack))) - (cond (next-octet - (setf (aref buffer buffer-pos) (the octet next-octet)) - (incf buffer-pos)) - (t (return))))) + (setq buffer (make-octet-buffer minimum)) ;; fill buffer for the first time or return immediately if ;; we don't succeed (unless (fill-buffer minimum) @@ -277,7 +278,7 @@ (unless (fill-buffer (compute-minimum)) (return-from next-octet))) (prog1 - (aref buffer buffer-pos) + (aref (the (array octet *) buffer) buffer-pos) (incf buffer-pos))) (unreader (char) (unread-char% char flexi-input-stream))) @@ -310,7 +311,7 @@ (when (>= buffer-pos buffer-end) (return)) (decf buffer-end) - (push (aref buffer buffer-end) octet-stack)) + (push (aref (the (array octet *) buffer) buffer-end) octet-stack)) (leave)) (let ((next-thing ,(if octetp '(next-octet) Modified: branches/edi/mapping.lisp ============================================================================== --- branches/edi/mapping.lisp (original) +++ branches/edi/mapping.lisp Tue May 20 19:45:25 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.1 2008/05/19 09:09:15 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.2 2008/05/20 21:15:45 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -40,9 +40,16 @@ #-:lispworks 'character) (deftype char-code-integer () - "The type of integers which can be returned by the function CHAR-CODE." + "The subtype of integers which can be returned by the function CHAR-CODE." '(integer 0 #.(1- char-code-limit))) +(deftype code-point () + "The subtype of integers that's just big enough to hold all Unicode +codepoints. + +See for example <http://unicode.org/glossary/#C>." + '(mod #x110000)) + (defmacro defconstant (name value &optional doc) "Make sure VALUE is evaluated only once \(to appease SBCL)." `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value) Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Tue May 20 19:45:25 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.54 2008/05/20 06:15:44 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.56 2008/05/20 23:44:45 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -29,37 +29,37 @@ (in-package :flexi-streams) -(defgeneric write-byte* (byte sink) +(defgeneric write-byte* (byte stream) + (declare #.*standard-optimize-settings*) (:documentation "Writes one byte \(octet) to the underlying stream -of SINK \(if SINK is a flexi stream) or adds the byte to the end of -SINK \(if SINK is an array with a fill pointer).")) +STREAM.")) #-:lispworks -(defmethod write-byte* (byte (sink flexi-output-stream)) +(defmethod write-byte* (byte (flexi-output-stream flexi-output-stream)) (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) - sink + flexi-output-stream (write-byte byte stream))) #+:lispworks -(defmethod write-byte* (byte (sink flexi-output-stream)) +(defmethod write-byte* (byte (flexi-output-stream flexi-output-stream)) (declare #.*standard-optimize-settings*) ;; we use WRITE-SEQUENCE because WRITE-BYTE doesn't work with all ;; bivalent streams in LispWorks (4.4.6) (with-accessors ((stream flexi-stream-stream)) - sink + flexi-output-stream (write-sequence (make-array 1 :element-type 'octet :initial-element byte) stream) byte)) #+:lispworks -(defmethod write-byte* (byte (sink flexi-binary-output-stream)) +(defmethod write-byte* (byte (flexi-output-stream flexi-binary-output-stream)) "Optimized version \(only needed for LispWorks) in case the underlying stream is binary." (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) - sink + flexi-output-stream (write-byte byte stream))) (defmethod stream-write-char ((stream flexi-output-stream) char) @@ -180,7 +180,7 @@ (return-from stream-write-sequence (call-next-method))) (let ((buffer (make-array (+ +buffer-size+ 20) - :element-type '(unsigned-byte 8) + :element-type 'octet :fill-pointer 0)) (last-newline-pos (position #\Newline sequence :test #'char= Modified: branches/edi/packages.lisp ============================================================================== --- branches/edi/packages.lisp (original) +++ branches/edi/packages.lisp Tue May 20 19:45:25 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.33 2008/05/19 07:57:08 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.34 2008/05/20 23:44:45 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -53,12 +53,13 @@ :flexi-io-stream :flexi-stream :flexi-stream-bound + :flexi-stream-column :flexi-stream-external-format :flexi-stream-element-type :flexi-stream-element-type-error :flexi-stream-element-type-error-element-type :flexi-stream-error - :flexi-stream-column + :flexi-stream-out-of-sync-error :flexi-stream-position :flexi-stream-stream :get-output-stream-sequence Modified: branches/edi/specials.lisp ============================================================================== --- branches/edi/specials.lisp (original) +++ branches/edi/specials.lisp Tue May 20 19:45:25 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.31 2008/05/19 07:57:08 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.32 2008/05/20 23:01:51 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -38,6 +38,17 @@ (compilation-speed 0)) "The standard optimize settings used by most declaration expressions.") +(defvar *fixnum-optimize-settings* + '(optimize + speed + (safety 0) + (space 0) + (debug 1) + (compilation-speed 0) + #+:lispworks (hcl:fixnum-safety 0)) + "Like *STANDARD-OPTIMIZE-SETTINGS*, but \(on LispWorks) with all +arithmetic being fixnum arithmetic.") + (defvar *current-unreader* nil "A unary function which might be called to `unread' a character \(i.e. the sequence of octets it represents). @@ -162,7 +173,7 @@ corresponding octets.") (defconstant +buffer-size+ 8192 - "Size of buffers used for internal purposes.") + "Default size for buffers used for internal purposes.") (pushnew :flexi-streams *features*) Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Tue May 20 19:45:25 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.30 2008/05/20 09:37:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.31 2008/05/20 23:01:53 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. Modified: branches/edi/util.lisp ============================================================================== --- branches/edi/util.lisp (original) +++ branches/edi/util.lisp Tue May 20 19:45:25 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.19 2008/05/19 22:32:57 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.21 2008/05/20 23:44:45 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -176,12 +176,20 @@ ,instance ,@body)) -(defun make-octet-buffer () +(defun make-octet-buffer (&optional (size +buffer-size+)) "Creates and returns a fresh buffer \(a specialized array) of size +BUFFER-SIZE+ to hold octets." - (make-array +buffer-size+ :element-type 'octet)) + (declare #.*standard-optimize-settings*) + (make-array size :element-type 'octet)) (defun type-equal (type1 type2) "Whether TYPE1 and TYPE2 denote the same type." + (declare #.*standard-optimize-settings*) (and (subtypep type1 type2) - (subtypep type2 type1))) \ No newline at end of file + (subtypep type2 type1))) + +(defun maybe-rewind (stream octets) + "Tries to `rewind' the \(binary) stream STREAM by OCTETS octets. +Returns a true value if it succeeds." + (when-let (position (file-position stream)) + (file-position stream (- position octets)))) \ No newline at end of file

1 0

[flexi-streams-cvs] r37 - branches/edi/test
by eweitz＠common-lisp.net 20 May '08

20 May '08

Author: eweitz Date: Tue May 20 08:56:10 2008 New Revision: 37 Modified: branches/edi/test/test.lisp Log: Remove debugging stuff Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Tue May 20 08:56:10 2008 @@ -532,11 +532,9 @@ (no-tests (* 8 (length compare-files-args-list)))) #+:lispworks (setq no-tests (* 2 no-tests)) - #+(or) (dolist (*copy-function* '(copy-stream copy-stream*)) (dolist (args compare-files-args-list) (apply 'compare-files args))) - #+(or) (let ((string-test-args-list (loop for (file-name symbols) in *test-files* nconc (create-test-combinations file-name symbols t)))) (incf no-tests (length string-test-args-list))

1 0

[flexi-streams-cvs] r36 - in branches/edi: . test
by eweitz＠common-lisp.net 20 May '08

20 May '08

Author: eweitz Date: Tue May 20 08:55:00 2008 New Revision: 36 Modified: branches/edi/decode.lisp branches/edi/input.lisp branches/edi/strings.lisp branches/edi/test/test.lisp Log: Checkpoint Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Tue May 20 08:55:00 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.14 2008/05/20 07:51:09 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.15 2008/05/20 09:37:43 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -239,6 +239,7 @@ (defmethod octets-to-char-code ((format flexi-cr-mixin) reader) (declare #.*standard-optimize-settings*) + (declare (ignore reader)) (let ((char-code (call-next-method))) (case char-code (#.(char-code #\Return) #.(char-code #\Newline)) @@ -247,6 +248,7 @@ (defmethod octets-to-char-code ((format flexi-crlf-mixin) reader) (declare #.*standard-optimize-settings*) (declare (function *current-unreader*)) + (declare (ignore reader)) (let ((char-code (call-next-method))) (case char-code (#.(char-code #\Return) Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Tue May 20 08:55:00 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.66 2008/05/20 00:37:27 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.67 2008/05/20 09:38:07 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -199,7 +199,9 @@ "An optimized version which uses a buffer underneath. The function can deliver characters as well as octets and it decides what to do based on the element type of the sequence \(which takes precedence) -and the element type of the stream." +and the element type of the stream. What you'll really get might also +depend on your Lisp. Some of the implementations are more picky than +others - see for example FLEXI-STREAMS-TEST:READ-SEQUENCE-TEST." (declare #.*standard-optimize-settings*) (declare (fixnum start end)) (with-accessors ((position flexi-stream-position) Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Tue May 20 08:55:00 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.20 2008/05/20 06:15:38 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.21 2008/05/20 09:04:23 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -130,7 +130,7 @@ (declare (inline next-char)) (etypecase factor (integer - (let* ((string-length (/ length factor)) + (let* ((string-length (ceiling length factor)) (string (make-array string-length :element-type 'char*))) (declare (fixnum string-length)) Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Tue May 20 08:55:00 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.29 2008/05/20 00:37:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.30 2008/05/20 09:37:30 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. @@ -339,11 +339,17 @@ (octets (file-as-octet-vector full-path)) (octet-length (length octets))) (when (external-format-equal external-format (make-external-format :utf8)) + #-:openmcl + ;; FLEXI-STREAMS puts integers into the list, but OpenMCL + ;; thinks they are characters... (with-open-file (in full-path :element-type 'octet) (let* ((in (make-flexi-stream in :external-format external-format)) (list (make-list octet-length))) (setf (flexi-stream-element-type in) 'octet) + #-:clisp (read-sequence list in) + #+:clisp + (ext:read-byte-sequence list in) (check (sequence-equal list octets)))) (with-open-file (in full-path :element-type 'octet) (let* ((in (make-flexi-stream in :external-format external-format)) @@ -370,7 +376,10 @@ (check (sequence-equal (loop repeat 50 collect (read-char in)) (subseq file-string 0 50))) + #-:clisp (read-sequence list in) + #+:clisp + (ext:read-char-sequence list in) (check (sequence-equal list (subseq file-string 50 (- string-length 50)))) (check (sequence-equal (loop repeat 50 collect (read-char in)) @@ -381,7 +390,10 @@ (check (sequence-equal (loop repeat 25 collect (read-char in)) (subseq file-string 0 25))) + #-:clisp (read-sequence array in) + #+:clisp + (ext:read-char-sequence array in) (check (sequence-equal array (subseq file-string 25 (- string-length 25)))) (check (sequence-equal (loop repeat 25 collect (read-char in)) @@ -500,11 +512,11 @@ (flet ((test-one-file (file-name external-format) (with-open-file (in (merge-pathnames file-name *this-file*) :element-type 'flex:octet) - (setq in (make-flexi-stream in :external-format external-format)) - (loop repeat 300 - for char = (read-char in) - do (unread-char char in) - (check (char= (read-char in) char)))))) + (let ((in (make-flexi-stream in :external-format external-format))) + (loop repeat 300 + for char = (read-char in) + do (unread-char char in) + (check (char= (read-char in) char))))))) (loop for (file-name symbols) in *test-files* do (loop for symbol in symbols do (loop for (file-name . external-format) in (create-file-variants file-name symbol) @@ -520,9 +532,11 @@ (no-tests (* 8 (length compare-files-args-list)))) #+:lispworks (setq no-tests (* 2 no-tests)) + #+(or) (dolist (*copy-function* '(copy-stream copy-stream*)) (dolist (args compare-files-args-list) (apply 'compare-files args))) + #+(or) (let ((string-test-args-list (loop for (file-name symbols) in *test-files* nconc (create-test-combinations file-name symbols t)))) (incf no-tests (length string-test-args-list))

1 0

[flexi-streams-cvs] r35 - in branches/edi: . doc test
by eweitz＠common-lisp.net 20 May '08

20 May '08

Author: eweitz Date: Tue May 20 04:03:28 2008 New Revision: 35 Modified: branches/edi/decode.lisp branches/edi/doc/index.html branches/edi/encode.lisp branches/edi/external-format.lisp branches/edi/input.lisp branches/edi/output.lisp branches/edi/strings.lisp branches/edi/test/test.lisp Log: Checkpoint Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Tue May 20 04:03:28 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.12 2008/05/19 22:32:56 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.14 2008/05/20 07:51:09 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -69,8 +69,7 @@ (declare #.*standard-optimize-settings*) (declare (function reader)) (when-let (octet (funcall reader)) - (declare (type octet octet)) - (if (> octet 127) + (if (> (the octet octet) 127) (recover-from-encoding-error format "No character which corresponds to octet #x~X." octet) octet))) @@ -81,8 +80,8 @@ (with-accessors ((decoding-table external-format-decoding-table)) format (when-let (octet (funcall reader)) - (declare (type octet octet)) - (let ((char-code (aref (the (simple-array char-code-integer *) decoding-table) octet))) + (let ((char-code (aref (the (simple-array char-code-integer *) decoding-table) + (the octet octet)))) (if (or (null char-code) (= (the char-code-integer char-code) 65533)) (recover-from-encoding-error format Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Tue May 20 04:03:28 2008 @@ -196,7 +196,9 @@ For more examples see the source code -of <a +of +<a href="http://mr-co.de/projects/cl-rfc2047/">CL-RFC2047</a>, +<a href="http://weitz.de/drakma/">Drakma</a>, <a href="http://weitz.de/chunga/">Chunga</a>, or <a href="http://weitz.de/cl-wbxml/">CL-WBXML</a>. @@ -970,29 +972,25 @@ <blockquote> Converts the Lisp string <code>string</code> from <code>start</code> to <code>end</code> to an array of -<a href="#octet">octets</a> corresponding to the <a href="#external-formats">external format</a> <code>external-format</code>. The defaults for +<a href="#octet">octets</a> corresponding to the external format designated by <a href="#external-formats">external format</a> <code>external-format</code>. The defaults for <code>start</code> and <code>end</code> -are <code>0</code> and the length of the -string. The default for <code>external-format</code> is the -value of -evaluating <code>(<a -href="#make-external-format">MAKE-EXTERNAL-FORMAT</a> :LATIN1)</code> +are <code>0</code> and the length of the string. The default +for <code>external-format</code> is <code>:LATIN1</code>. </blockquote> [Function] <a class=none name="octets-to-string">octets-to-string sequence <tt>&key</tt> external-format start end => string</a> -<blockquote> Converts the Lisp sequence <code>sequence</code> -of <a href="#octet">octets</a> from <code>start</code> -to <code>end</code> to string using -the <a href="#external-formats">external +<blockquote> Converts the Lisp +sequence <code>sequence</code> of <a href="#octet">octets</a> +from <code>start</code> to <code>end</code> to string +using the external format designated +by <a href="#external-formats">external format</a> <code>external-format</code>. The defaults for <code>start</code> and <code>end</code> are <code>0</code> and the length of the sequence. The default -for <code>external-format</code> is the value of -evaluating <code>(<a -href="#make-external-format">MAKE-EXTERNAL-FORMAT</a> :LATIN1)</code> +for <code>external-format</code> is <code>:LATIN1</code>. </blockquote>   <h3><a class=none name="position">File positions</a></h3> @@ -1032,7 +1030,7 @@ numerous patches and additions. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.102 2008/05/19 07:57:10 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.104 2008/05/20 06:55:21 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: branches/edi/encode.lisp ============================================================================== --- branches/edi/encode.lisp (original) +++ branches/edi/encode.lisp Tue May 20 04:03:28 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.10 2008/05/19 22:32:56 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.11 2008/05/20 08:02:49 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -101,7 +101,7 @@ (flet ((write-word (word) (funcall writer (ldb (byte 8 0) word)) (funcall writer (ldb (byte 8 8) word)))) - (declare (inline read-next-word)) + (declare (inline write-word)) (let ((char-code (char-code char))) (declare (type char-code-integer char-code)) (cond ((< char-code #x10000) @@ -116,7 +116,7 @@ (flet ((write-word (word) (funcall writer (ldb (byte 8 8) word)) (funcall writer (ldb (byte 8 0) word)))) - (declare (inline read-next-word)) + (declare (inline write-word)) (let ((char-code (char-code char))) (declare (type char-code-integer char-code)) (cond ((< char-code #x10000) Modified: branches/edi/external-format.lisp ============================================================================== --- branches/edi/external-format.lisp (original) +++ branches/edi/external-format.lisp Tue May 20 04:03:28 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.19 2008/05/19 11:20:11 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.20 2008/05/20 08:02:50 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -219,7 +219,7 @@ (declare #.*standard-optimize-settings*) (declare (ignore initargs)) (with-accessors ((encoding-hash external-format-encoding-hash) - (decoding-table flexi-stream-decoding-table) + (decoding-table external-format-decoding-table) (name external-format-name) (id external-format-id)) external-format Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Tue May 20 04:03:28 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.65 2008/05/19 22:54:10 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.66 2008/05/20 00:37:27 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -196,6 +196,10 @@ (stream-read-char stream))) (defmethod stream-read-sequence ((flexi-input-stream flexi-input-stream) sequence start end &key) + "An optimized version which uses a buffer underneath. The function +can deliver characters as well as octets and it decides what to do +based on the element type of the sequence \(which takes precedence) +and the element type of the stream." (declare #.*standard-optimize-settings*) (declare (fixnum start end)) (with-accessors ((position flexi-stream-position) @@ -207,21 +211,31 @@ (element-type flexi-stream-element-type) (stream flexi-stream-stream)) flexi-input-stream - (let ((buffer (make-octet-buffer)) - (buffer-pos 0) - (buffer-end 0) - (index start)) - (declare (fixnum buffer-pos buffer-end index) + (let* ((buffer (make-octet-buffer)) + (buffer-pos 0) + (buffer-end 0) + (index start) + (want-chars-p (or (stringp sequence) + (and (vectorp sequence) + (not (subtypep (array-element-type sequence) 'integer))) + (type-equal element-type 'octet))) + (factor (if want-chars-p (encoding-factor external-format) 1)) + (integer-factor (floor factor)) + ;; it's an interesting question whether it makes sense + ;; performance-wise to make RESERVE significantly bigger + ;; (and thus put potentially a lot more octets into + ;; OCTET-STACK), especially for UTF-8 + (reserve (if (floatp factor) (* 2 integer-factor) 0))) + (declare (fixnum buffer-pos buffer-end index integer-factor reserve) (type (array octet *) buffer)) (flet ((compute-minimum () "Computes the minimum amount of octets we can savely read into the buffer without violating the stream's bound \(if there -is one) and without potentially reading more than we need." - ;; this has to be done conservatively, unfortunately - - ;; it is possible that we only fill the buffer in very - ;; small chunks once we're near END (but this is only - ;; relevant for multi-byte encodings, of course) - (let ((minimum (min (the fixnum (- end index)) +buffer-size+))) +is one) and without potentially reading much more than we need." + (let ((minimum (min (the fixnum (+ (the fixnum (* integer-factor + (the fixnum (- end index)))) + reserve)) + +buffer-size+))) (cond (bound (min minimum (- bound position))) (t minimum)))) (fill-buffer (end) @@ -286,7 +300,16 @@ ,(sublis '((index . (1- index))) set-place))) (return-from stream-read-sequence index))) (loop - (when (>= index end) (leave)) + (when (>= index end) + ;; check if there are octets in the + ;; buffer we didn't use - see + ;; COMPUTE-MINIMUM above + (loop + (when (>= buffer-pos buffer-end) + (return)) + (decf buffer-end) + (push (aref buffer buffer-end) octet-stack)) + (leave)) (let ((next-thing ,(if octetp '(next-octet) '(octets-to-char-code external-format #'next-octet)))) Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Tue May 20 04:03:28 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.52 2008/05/19 22:32:56 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.54 2008/05/20 06:15:44 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -129,6 +129,19 @@ ;; needed for AllegroCL - grrr... (stream-write-char stream #\Newline)) +;; TODO: file-position -> octet-stack (and others?) + +;; other way around: function "resync" trying to use File-position? + +;; "resync" independent function to empty octet-stack? +;; (decrement-file-position) => success +;; (resync ... &optional how-much (length octet-stack)) => success + +;; in stream-read-sequence: if file stream, read more into buffer, +;; then resync with file-position? + +;; TODO: interaction between read and write + (defmethod stream-write-sequence ((flexi-output-stream flexi-output-stream) sequence start end &key) "Writes all elements of the sequence SEQUENCE from START to END to the underlying stream. The elements can be either octets or Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Tue May 20 04:03:28 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.19 2008/05/19 22:32:56 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.20 2008/05/20 06:15:38 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -30,10 +30,11 @@ (in-package :flexi-streams) (defun string-to-octets (string &key - (external-format (make-external-format :latin1)) + (external-format :latin1) (start 0) (end (length string))) "Converts the Lisp string STRING from START to END to an array of -octets corresponding to the external format EXTERNAL-FORMAT." +octets corresponding to the external format designated by +EXTERNAL-FORMAT." (declare #.*standard-optimize-settings*) (declare (fixnum start end) (string string)) (setq external-format (maybe-convert-external-format external-format)) @@ -87,10 +88,10 @@ octets)))))) (defun octets-to-string (sequence &key - (external-format (make-external-format :latin1)) + (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 EXTERNAL-FORMAT." +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)) Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Tue May 20 04:03:28 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.28 2008/05/19 23:54:55 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.29 2008/05/20 00:37:30 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. @@ -367,19 +367,25 @@ (with-open-file (in full-path :element-type 'octet) (let* ((in (make-flexi-stream in :external-format external-format)) (list (make-list (- string-length 100)))) - (check (sequence-equal (loop repeat 100 + (check (sequence-equal (loop repeat 50 collect (read-char in)) - (subseq file-string 0 100))) + (subseq file-string 0 50))) (read-sequence list in) - (check (sequence-equal list (subseq file-string 100))))) + (check (sequence-equal list (subseq file-string 50 (- string-length 50)))) + (check (sequence-equal (loop repeat 50 + collect (read-char in)) + (subseq file-string (- string-length 50)))))) (with-open-file (in full-path :element-type 'octet) (let* ((in (make-flexi-stream in :external-format external-format)) (array (make-array (- string-length 50)))) - (check (sequence-equal (loop repeat 50 + (check (sequence-equal (loop repeat 25 collect (read-char in)) - (subseq file-string 0 50))) + (subseq file-string 0 25))) (read-sequence array in) - (check (sequence-equal array (subseq file-string 50)))))))) + (check (sequence-equal array (subseq file-string 25 (- string-length 25)))) + (check (sequence-equal (loop repeat 25 + collect (read-char in)) + (subseq file-string (- string-length 25))))))))) (defmacro using-values ((&rest values) &body body) "Executes BODY and feeds an element from VALUES to the USE-VALUE @@ -514,11 +520,9 @@ (no-tests (* 8 (length compare-files-args-list)))) #+:lispworks (setq no-tests (* 2 no-tests)) - #+(or) (dolist (*copy-function* '(copy-stream copy-stream*)) (dolist (args compare-files-args-list) (apply 'compare-files args))) - #+(or) (let ((string-test-args-list (loop for (file-name symbols) in *test-files* nconc (create-test-combinations file-name symbols t)))) (incf no-tests (length string-test-args-list)) @@ -530,10 +534,8 @@ (dolist (args read-sequence-test-args-list) (apply 'read-sequence-test args))) (incf no-tests) - #+(or) (error-handling-test) (incf no-tests) - #+(or) (unread-char-test) (format *error-output* "~%~%~:[~A of ~A tests failed..~;~*All ~A tests passed~].~%" (= no-tests *test-success-counter*) (- no-tests *test-success-counter*) no-tests)))

1 0

[flexi-streams-cvs] r34 - branches/edi/test
by eweitz＠common-lisp.net 19 May '08

19 May '08

Author: eweitz Date: Mon May 19 19:55:12 2008 New Revision: 34 Modified: branches/edi/test/test.lisp Log: More tests Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Mon May 19 19:55:12 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.27 2008/05/19 19:47:17 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.28 2008/05/19 23:54:55 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. @@ -323,6 +323,64 @@ (check (string= (old-octets-to-string octets-list :external-format external-format) string)) (check (equalp (old-string-to-octets string :external-format external-format) octets-vector))))) +(defun sequence-equal (seq1 seq2) + "Whether the two sequences have the same elements." + (and (= (length seq1) (length seq2)) + (loop for i below (length seq1) + always (eql (elt seq1 i) (elt seq2 i))))) + +(defun read-sequence-test (pathspec external-format) + "Several tests to confirm that READ-SEQUENCE behaves as expected." + (with-test ((format nil "READ-SEQUENCE tests with format ~S." + (flex::normalize-external-format external-format))) + (let* ((full-path (merge-pathnames pathspec *this-file*)) + (file-string (file-as-string full-path external-format)) + (string-length (length file-string)) + (octets (file-as-octet-vector full-path)) + (octet-length (length octets))) + (when (external-format-equal external-format (make-external-format :utf8)) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (list (make-list octet-length))) + (setf (flexi-stream-element-type in) 'octet) + (read-sequence list in) + (check (sequence-equal list octets)))) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (third (floor octet-length 3)) + (half (floor octet-length 2)) + (vector (make-array half :element-type 'octet))) + (check (sequence-equal (loop repeat third + collect (read-byte in)) + (subseq octets 0 third))) + (read-sequence vector in) + (check (sequence-equal vector (subseq octets third (+ third half))))))) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (string (make-string (- string-length 10) :element-type 'flex::char*))) + (setf (flexi-stream-element-type in) 'octet) + (check (sequence-equal (loop repeat 10 + collect (read-char in)) + (subseq file-string 0 10))) + (read-sequence string in) + (check (sequence-equal string (subseq file-string 10))))) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (list (make-list (- string-length 100)))) + (check (sequence-equal (loop repeat 100 + collect (read-char in)) + (subseq file-string 0 100))) + (read-sequence list in) + (check (sequence-equal list (subseq file-string 100))))) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (array (make-array (- string-length 50)))) + (check (sequence-equal (loop repeat 50 + collect (read-char in)) + (subseq file-string 0 50))) + (read-sequence array in) + (check (sequence-equal array (subseq file-string 50)))))))) + (defmacro using-values ((&rest values) &body body) "Executes BODY and feeds an element from VALUES to the USE-VALUE restart each time a EXTERNAL-FORMAT-ENCODING-ERROR is signalled. @@ -456,17 +514,26 @@ (no-tests (* 8 (length compare-files-args-list)))) #+:lispworks (setq no-tests (* 2 no-tests)) + #+(or) (dolist (*copy-function* '(copy-stream copy-stream*)) (dolist (args compare-files-args-list) (apply 'compare-files args))) + #+(or) (let ((string-test-args-list (loop for (file-name symbols) in *test-files* nconc (create-test-combinations file-name symbols t)))) (incf no-tests (length string-test-args-list)) (dolist (args string-test-args-list) (apply 'string-test args))) + (let ((read-sequence-test-args-list (loop for (file-name symbols) in *test-files* + nconc (create-test-combinations file-name symbols t)))) + (incf no-tests (length read-sequence-test-args-list)) + (dolist (args read-sequence-test-args-list) + (apply 'read-sequence-test args))) (incf no-tests) + #+(or) (error-handling-test) (incf no-tests) + #+(or) (unread-char-test) (format *error-output* "~%~%~:[~A of ~A tests failed..~;~*All ~A tests passed~].~%" (= no-tests *test-success-counter*) (- no-tests *test-success-counter*) no-tests)))

1 0

[flexi-streams-cvs] r33 - branches/edi
by eweitz＠common-lisp.net 19 May '08

19 May '08

Author: eweitz Date: Mon May 19 18:59:07 2008 New Revision: 33 Modified: branches/edi/decode.lisp branches/edi/encode.lisp branches/edi/external-format.lisp branches/edi/flexi-streams.asd branches/edi/input.lisp branches/edi/mapping.lisp branches/edi/output.lisp branches/edi/stream.lisp branches/edi/strings.lisp branches/edi/util.lisp Log: Better read-sequence implementation Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Mon May 19 18:59:07 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.9 2008/05/19 07:57:07 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.12 2008/05/19 22:32:56 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -52,24 +52,23 @@ (defgeneric octets-to-char-code (format reader) (declare #.*standard-optimize-settings*) (:documentation "Converts a sequence of octets to a character code -\(which is returned) using the external format FORMAT. The sequence -is obtained by calling the function \(which must be a functional -object) READER with no arguments which should return one octet per -call. +\(which is returned, or NIL in case of EOF) using the external format +FORMAT. The sequence is obtained by calling the function \(which must +be a functional object) READER with no arguments which should return +one octet per call. In the case of EOF, READER should return NIL. -The special variables *CURRENT-STREAM* and *CURRENT-UNREADER* must be -bound correctly whenever this function is called.")) +The special variable *CURRENT-UNREADER* must be bound correctly +whenever this function is called.")) (defmethod octets-to-char-code ((format flexi-latin-1-format) reader) (declare #.*standard-optimize-settings*) (declare (function reader)) - (or (funcall reader) :eof)) + (funcall reader)) (defmethod octets-to-char-code ((format flexi-ascii-format) reader) (declare #.*standard-optimize-settings*) (declare (function reader)) - (let ((octet (or (funcall reader) - (return-from octets-to-char-code :eof)))) + (when-let (octet (funcall reader)) (declare (type octet octet)) (if (> octet 127) (recover-from-encoding-error format @@ -81,15 +80,14 @@ (declare (function reader)) (with-accessors ((decoding-table external-format-decoding-table)) format - (let* ((octet (or (funcall reader) - (return-from octets-to-char-code :eof))) - (char-code (aref (the (simple-array char-code-integer *) decoding-table) octet))) + (when-let (octet (funcall reader)) (declare (type octet octet)) - (if (or (null char-code) - (= (the char-code-integer char-code) 65533)) - (recover-from-encoding-error format - "No character which corresponds to octet #x~X." octet) - char-code)))) + (let ((char-code (aref (the (simple-array char-code-integer *) decoding-table) octet))) + (if (or (null char-code) + (= (the char-code-integer char-code) 65533)) + (recover-from-encoding-error format + "No character which corresponds to octet #x~X." octet) + char-code))))) (defmethod octets-to-char-code ((format flexi-utf-8-format) reader) (declare #.*standard-optimize-settings*) @@ -103,7 +101,7 @@ (return-from octets-to-char-code (recover-from-encoding-error format "End of data while in UTF-8 sequence."))) - (t (return-from octets-to-char-code :eof)))) + (t (return-from octets-to-char-code nil)))) (setq first-octet-seen t)))) (let ((octet (read-next-byte))) (declare (type octet octet)) @@ -150,11 +148,12 @@ (return-from octets-to-char-code (recover-from-encoding-error format "End of data while in UTF-16 sequence."))) - (t (return-from octets-to-char-code :eof)))) + (t (return-from octets-to-char-code nil)))) (setq first-octet-seen t)))) (flet ((read-next-word () (+ (the octet (read-next-byte)) (ash (the octet (read-next-byte)) 8)))) + (declare (inline read-next-word)) (let ((word (read-next-word))) (declare (type (unsigned-byte 16) word)) (cond ((<= #xd800 word #xdfff) @@ -182,11 +181,12 @@ (return-from octets-to-char-code (recover-from-encoding-error format "End of data while in UTF-16 sequence."))) - (t (return-from octets-to-char-code :eof)))) + (t (return-from octets-to-char-code nil)))) (setq first-octet-seen t)))) (flet ((read-next-word () (+ (ash (the octet (read-next-byte)) 8) (the octet (read-next-byte))))) + (declare (inline read-next-word)) (let ((word (read-next-word))) (declare (type (unsigned-byte 16) word)) (cond ((<= #xd800 word #xdfff) @@ -214,7 +214,7 @@ (return-from octets-to-char-code (recover-from-encoding-error format "End of data while in UTF-32 sequence."))) - (t (return-from octets-to-char-code :eof)))) + (t (return-from octets-to-char-code nil)))) (setq first-octet-seen t)))) (loop for count of-type fixnum from 0 to 24 by 8 for octet of-type octet = (read-next-byte) @@ -232,7 +232,7 @@ (return-from octets-to-char-code (recover-from-encoding-error format "End of data while in UTF-32 sequence."))) - (t (return-from octets-to-char-code :eof)))) + (t (return-from octets-to-char-code nil)))) (setq first-octet-seen t)))) (loop for count of-type fixnum from 24 downto 0 by 8 for octet of-type octet = (read-next-byte) @@ -243,7 +243,6 @@ (let ((char-code (call-next-method))) (case char-code (#.(char-code #\Return) #.(char-code #\Newline)) - (:eof :eof) (otherwise char-code)))) (defmethod octets-to-char-code ((format flexi-crlf-mixin) reader) @@ -255,11 +254,12 @@ (let ((next-char-code (call-next-method))) (case next-char-code (#.(char-code #\Linefeed) #.(char-code #\Newline)) - (:eof char-code) + ;; we saw a CR but no LF afterwards, but then the data + ;; ended, so we just return #\Return + ((nil) #.(char-code #\Return)) ;; if the character we peeked at wasn't a ;; linefeed character we unread its constituents (otherwise (funcall *current-unreader* (code-char next-char-code)) char-code)))) - (:eof :eof) - (t char-code)))) + (otherwise char-code)))) Modified: branches/edi/encode.lisp ============================================================================== --- branches/edi/encode.lisp (original) +++ branches/edi/encode.lisp Mon May 19 18:59:07 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.8 2008/05/19 07:57:07 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.10 2008/05/19 22:32:56 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -35,10 +35,7 @@ using the external format FORMAT. The conversion is performed by calling the unary function \(which must be a functional object) WRITER repeatedly each octet. The return value of this function is -unspecified. - -The special variable *CURRENT-STREAM* must be bound correctly whenever -this function is called.")) +unspecified.")) (defmethod char-to-octets ((format flexi-latin-1-format) char writer) (declare #.*standard-optimize-settings*) @@ -104,6 +101,7 @@ (flet ((write-word (word) (funcall writer (ldb (byte 8 0) word)) (funcall writer (ldb (byte 8 8) word)))) + (declare (inline read-next-word)) (let ((char-code (char-code char))) (declare (type char-code-integer char-code)) (cond ((< char-code #x10000) @@ -118,6 +116,7 @@ (flet ((write-word (word) (funcall writer (ldb (byte 8 8) word)) (funcall writer (ldb (byte 8 0) word)))) + (declare (inline read-next-word)) (let ((char-code (char-code char))) (declare (type char-code-integer char-code)) (cond ((< char-code #x10000) Modified: branches/edi/external-format.lisp ============================================================================== --- branches/edi/external-format.lisp (original) +++ branches/edi/external-format.lisp Mon May 19 18:59:07 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.18 2008/05/18 15:54:34 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.19 2008/05/19 11:20:11 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -390,8 +390,8 @@ (:documentation "Given an external format FORMAT, returns a factor which denotes the octets to characters ratio to expect when encoding/decoding. If the returned value is an integer, the factor is -assumed to be exact. If it is a float, the factor is supposed to be -based on heuristics and usually not exact. +assumed to be exact. If it is a \(double) float, the factor is +supposed to be based on heuristics and usually not exact. This factor is used in string.lisp.") (declare #.*standard-optimize-settings*)) @@ -407,7 +407,7 @@ ;; UTF-8 characters can be anything from one to six octets, but we ;; assume that the "overhead" is only about 5 percent - this ;; estimate is obviously very much dependant on the content - 1.05) + 1.05d0) (defmethod encoding-factor ((format flexi-utf-16-format)) (declare #.*standard-optimize-settings*) @@ -415,7 +415,7 @@ ;; code points above #x10000 map to four octets - we assume that we ;; usually don't see these characters but of course have to return a ;; float - 2.0) + 2.0d0) (defmethod encoding-factor ((format flexi-utf-32-format)) (declare #.*standard-optimize-settings*) @@ -427,4 +427,4 @@ ;; if the sequence #\Return #\Linefeed is the line-end marker, this ;; obviously makes encodings potentially longer and definitely makes ;; the estimate unexact - (* 1.02 (call-next-method))) \ No newline at end of file + (* 1.02d0 (call-next-method))) Modified: branches/edi/flexi-streams.asd ============================================================================== --- branches/edi/flexi-streams.asd (original) +++ branches/edi/flexi-streams.asd Mon May 19 18:59:07 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.62 2008/05/18 20:34:52 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.63 2008/05/18 23:13:59 edi Exp $ ;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. @@ -39,8 +39,8 @@ :serial t :components ((:file "packages") (:file "mapping") - (:file "ascii") - (:file "koi8-r") + (:file "ascii") + (:file "koi8-r") (:file "iso-8859") (:file "code-pages") (:file "specials") Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Mon May 19 18:59:07 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.60 2008/05/19 07:57:07 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.65 2008/05/19 22:54:10 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -34,7 +34,7 @@ "Reads one byte \(octet) from the underlying stream of FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty)." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; we're using S instead of STREAM here because of an ;; issue with SBCL: ;; <http://article.gmane.org/gmane.lisp.steel-bank.general/1386> @@ -58,7 +58,7 @@ "Reads one byte \(octet) from the underlying stream of FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty)." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) (octet-stack flexi-stream-octet-stack) @@ -85,7 +85,7 @@ FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty). Optimized version \(only needed for LispWorks) in case the underlying stream is binary." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) (octet-stack flexi-stream-octet-stack) @@ -104,7 +104,7 @@ (defmethod stream-clear-input ((flexi-input-stream flexi-input-stream)) "Calls the corresponding method for the underlying input stream and also clears the value of the OCTET-STACK slot." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; note that we don't reset the POSITION slot (with-accessors ((octet-stack flexi-stream-octet-stack) (stream flexi-stream-stream)) @@ -116,12 +116,14 @@ "Calls the corresponding method for the underlying input stream but first checks if \(old) input is available in the OCTET-STACK slot." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) (octet-stack flexi-stream-octet-stack) (stream flexi-stream-stream)) flexi-input-stream + (declare (integer position) + (type (or null integer) bound)) (when (and bound (>= position bound)) (return-from stream-listen nil)) @@ -129,7 +131,7 @@ (defmethod stream-read-byte ((stream flexi-input-stream)) "Reads one byte \(octet) from the underlying stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; set LAST-CHAR-CODE slot to NIL because we can't UNREAD-CHAR after ;; this operation (with-accessors ((last-char-code flexi-stream-last-char-code) @@ -144,6 +146,7 @@ "Used internally to put a character CHAR which was already read back on the stream. Uses the OCTET-STACK slot and decrements the POSITION slot accordingly." + (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (octet-stack flexi-stream-octet-stack) (external-format flexi-stream-external-format)) @@ -151,16 +154,16 @@ (let ((counter 0) octets-reversed) (declare (integer position) (fixnum counter)) - (char-to-octets external-format - char - (lambda (octet) - (incf counter) - (push octet octets-reversed))) - (decf position counter) - (setq octet-stack (nreconc octets-reversed octet-stack))))) + (flet ((writer (octet) + (incf counter) + (push octet octets-reversed))) + (declare (dynamic-extent (function writer))) + (char-to-octets external-format char #'writer) + (decf position counter) + (setq octet-stack (nreconc octets-reversed octet-stack)))))) (defmethod stream-read-char ((stream flexi-input-stream)) - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; 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 @@ -171,67 +174,148 @@ ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after ;; this operation (setq last-octet nil) - (let* ((*current-unreader* (lambda (char) - (unread-char% char stream))) - (char-code (octets-to-char-code external-format - (lambda () - (read-byte* stream))))) - ;; remember this character and its char code for UNREAD-CHAR - (setq last-char-code char-code) - (or (code-char char-code) char-code)))) + (flet ((reader () + (read-byte* stream)) + (unreader (char) + (unread-char% char stream))) + (declare (dynamic-extent (function reader) (function unreader))) + (let* ((*current-unreader* #'unreader) + (char-code (or (octets-to-char-code external-format #'reader) + (return-from stream-read-char :eof)))) + ;; remember this character and its char code for UNREAD-CHAR + (setq last-char-code char-code) + (or (code-char char-code) char-code))))) (defmethod stream-read-char-no-hang ((stream flexi-input-stream)) "Reads one character if the underlying stream has at least one octet available." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; note that this may block for non-8-bit encodings - I think ;; there's no easy way to handle this correctly (and (stream-listen stream) (stream-read-char stream))) (defmethod stream-read-sequence ((flexi-input-stream flexi-input-stream) sequence start end &key) - "Reads enough input from STREAM to fill SEQUENCE from START to END. -If SEQUENCE is an array which can store octets we use READ-SEQUENCE to -fill it in one fell swoop, otherwise we iterate using -STREAM-READ-CHAR." - (declare (optimize speed) - (type (integer 0 *) start end)) - (with-accessors ((last-char-code flexi-stream-last-char-code) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((position flexi-stream-position) + (bound flexi-stream-bound) + (octet-stack flexi-stream-octet-stack) + (external-format flexi-stream-external-format) (last-octet flexi-stream-last-octet) - (stream flexi-stream-stream) - (position flexi-stream-position) - (octet-stack flexi-stream-octet-stack)) + (last-char-code flexi-stream-last-char-code) + (element-type flexi-stream-element-type) + (stream flexi-stream-stream)) flexi-input-stream - (declare (integer position)) - (cond ((and (arrayp sequence) - (subtypep 'octet (array-element-type sequence))) - (setf last-char-code nil) - (let ((cursor start)) - (loop with stack = octet-stack - for continuep = (< cursor end) - for octet = (and continuep (pop stack)) - while octet - do (setf (aref sequence cursor) (the octet octet)) - (incf cursor)) - (let ((index - (read-sequence sequence stream :start cursor :end end))) - (incf position (- index start)) - (when (> index start) - (setq last-octet (aref sequence (1- index)))) - index))) - (t - (loop for index from start below end - for element = (stream-read-char flexi-input-stream) - until (eq element :eof) - do (setf (elt sequence index) element) - finally (return index)))))) + (let ((buffer (make-octet-buffer)) + (buffer-pos 0) + (buffer-end 0) + (index start)) + (declare (fixnum buffer-pos buffer-end index) + (type (array octet *) buffer)) + (flet ((compute-minimum () + "Computes the minimum amount of octets we can savely +read into the buffer without violating the stream's bound \(if there +is one) and without potentially reading more than we need." + ;; this has to be done conservatively, unfortunately - + ;; it is possible that we only fill the buffer in very + ;; small chunks once we're near END (but this is only + ;; relevant for multi-byte encodings, of course) + (let ((minimum (min (the fixnum (- end index)) +buffer-size+))) + (cond (bound (min minimum (- bound position))) + (t minimum)))) + (fill-buffer (end) + "Tries to fill the buffer from BUFFER-POS to END and +returns NIL if the buffer doesn't contain any new data." + (setq buffer-end (read-sequence buffer stream + :start buffer-pos + :end end)) + ;; BUFFER-POS is only greater than zero if the buffer + ;; already contains unread data from the octet stack + ;; (see below), so we test for ZEROP here and do /not/ + ;; compare with BUFFER-POS + (unless (zerop buffer-end) + (incf position buffer-end)))) + (let ((minimum (compute-minimum))) + (declare (fixnum minimum)) + ;; put data from octet stack into buffer if there is any + (loop + (when (>= buffer-pos minimum) + (return)) + (let ((next-octet (pop octet-stack))) + (cond (next-octet + (setf (aref buffer buffer-pos) (the octet next-octet)) + (incf buffer-pos)) + (t (return))))) + ;; fill buffer for the first time or return immediately if + ;; we don't succeed + (unless (fill-buffer minimum) + (return-from stream-read-sequence start))) + (setq buffer-pos 0) + (flet ((next-octet () + "Returns the next octet from the buffer and fills it +if it is exhausted. Returns NIL if there's no more data on the +stream." + (when (>= buffer-pos buffer-end) + (setq buffer-pos 0) + (unless (fill-buffer (compute-minimum)) + (return-from next-octet))) + (prog1 + (aref buffer buffer-pos) + (incf buffer-pos))) + (unreader (char) + (unread-char% char flexi-input-stream))) + (declare (dynamic-extent (function next-octet) (function unreader))) + (let ((*current-unreader* #'unreader)) + (macrolet ((iterate (octetp set-place) + "A very unhygienic macro to implement the +actual iteration through the sequence including housekeeping for the +flexi stream. If OCTETP is true, we put octets into the stream, +otherwise characters. SET-PLACE is the place \(using the index INDEX) +used to access the sequence." + `(flet ((leave () + "This is the function used to abort +the LOOP iteration below." + (when (> index start) + ;; if something was read at all, + ;; update LAST-OCTET and + ;; LAST-CHAR-CODE accordingly + (setq ,(if octetp 'last-char-code 'last-octet) + nil + ,(if octetp 'last-octet 'last-char-code) + ,(sublis '((index . (1- index))) set-place))) + (return-from stream-read-sequence index))) + (loop + (when (>= index end) (leave)) + (let ((next-thing ,(if octetp + '(next-octet) + '(octets-to-char-code external-format #'next-octet)))) + (unless next-thing (leave)) + (setf ,set-place ,(if octetp 'next-thing '(code-char next-thing))) + (incf index)))))) + (etypecase sequence + (string (iterate nil (char sequence index))) + (array + (let ((array-element-type (array-element-type sequence))) + (cond ((type-equal array-element-type 'octet) + (iterate t (aref (the (array octet *) sequence) index))) + ((or (subtypep array-element-type 'integer) + (type-equal element-type 'octet)) + (iterate t (aref sequence index))) + (t + (iterate nil (aref sequence index)))))) + (list + (cond ((type-equal element-type 'octet) + (iterate t (nth index sequence))) + (t + (iterate nil (nth index sequence))))))))))))) (defmethod stream-unread-char ((stream flexi-input-stream) char) "Implements UNREAD-CHAR for streams of type FLEXI-INPUT-STREAM. Makes sure CHAR will only be unread if it was the last character read and if it was read with the same encoding that's currently being used by the stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((last-char-code flexi-stream-last-char-code)) stream (unless last-char-code @@ -249,7 +333,7 @@ "Similar to UNREAD-CHAR in that it `unreads' the last octet from STREAM. Note that you can only call UNREAD-BYTE after a corresponding READ-BYTE." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((last-octet flexi-stream-last-octet) (octet-stack flexi-stream-octet-stack) (position flexi-stream-position)) @@ -274,7 +358,7 @@ not 0 is returned, if PEEK-TYPE is an octet, the next octet which equals PEEK-TYPE is returned. EOF-ERROR-P and EOF-VALUE are interpreted as usual." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (loop for octet = (read-byte flexi-input-stream eof-error-p eof-value) until (cond ((null peek-type)) ((eql octet eof-value)) Modified: branches/edi/mapping.lisp ============================================================================== --- branches/edi/mapping.lisp (original) +++ branches/edi/mapping.lisp Mon May 19 18:59:07 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.15 2008/05/18 15:54:34 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.1 2008/05/19 09:09:15 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Mon May 19 18:59:07 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.50 2008/05/19 07:57:07 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.52 2008/05/19 22:32:56 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -36,14 +36,14 @@ #-:lispworks (defmethod write-byte* (byte (sink flexi-output-stream)) - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) sink (write-byte byte stream))) #+:lispworks (defmethod write-byte* (byte (sink flexi-output-stream)) - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; we use WRITE-SEQUENCE because WRITE-BYTE doesn't work with all ;; bivalent streams in LispWorks (4.4.6) (with-accessors ((stream flexi-stream-stream)) @@ -57,22 +57,22 @@ (defmethod write-byte* (byte (sink flexi-binary-output-stream)) "Optimized version \(only needed for LispWorks) in case the underlying stream is binary." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) sink (write-byte byte stream))) (defmethod stream-write-char ((stream flexi-output-stream) char) - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((external-format flexi-stream-external-format)) stream - (char-to-octets external-format - char - (lambda (octet) - (write-byte* octet stream))))) + (flet ((writer (octet) + (write-byte* octet stream))) + (declare (dynamic-extent (function writer))) + (char-to-octets external-format char #'writer)))) (defmethod stream-write-char :after ((stream flexi-output-stream) char) - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; update the column unless we're in the middle of the line and ;; the current value is NIL (with-accessors ((column flexi-stream-column)) @@ -83,7 +83,7 @@ (defmethod stream-clear-output ((flexi-output-stream flexi-output-stream)) "Simply calls the corresponding method for the underlying output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) flexi-output-stream (clear-output stream))) @@ -91,7 +91,7 @@ (defmethod stream-finish-output ((flexi-output-stream flexi-output-stream)) "Simply calls the corresponding method for the underlying output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) flexi-output-stream (finish-output stream))) @@ -99,7 +99,7 @@ (defmethod stream-force-output ((flexi-output-stream flexi-output-stream)) "Simply calls the corresponding method for the underlying output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) flexi-output-stream (force-output stream))) @@ -107,14 +107,14 @@ (defmethod stream-line-column ((flexi-output-stream flexi-output-stream)) "Returns the column stored in the COLUMN slot of the FLEXI-OUTPUT-STREAM object STREAM." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((column flexi-stream-column)) flexi-output-stream column)) (defmethod stream-write-byte ((flexi-output-stream flexi-output-stream) byte) "Writes a byte \(octet) to the underlying stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((column flexi-stream-column)) flexi-output-stream ;; set column to NIL because we don't know how to handle binary @@ -125,7 +125,7 @@ #+:allegro (defmethod stream-terpri ((stream flexi-output-stream)) "Writes a #\Newline character to the underlying stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; needed for AllegroCL - grrr... (stream-write-char stream #\Newline)) @@ -135,8 +135,8 @@ characters. Characters are output according to the current encoding \(external format) of the FLEXI-OUTPUT-STREAM object STREAM." - (declare (optimize speed) - (type (integer 0 *) start end)) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) (with-accessors ((stream flexi-stream-stream) (column flexi-stream-column)) flexi-output-stream @@ -158,8 +158,8 @@ "Optimized method for the cases where SEQUENCE is a string. Fills an internal buffer and uses repeated calls to WRITE-SEQUENCE to write to the underlying stream." - (declare (optimize speed) - (type (integer 0 *) start end)) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) ;; don't use this optimized method for bivalent character streams on ;; LispWorks, as it currently gets confused by the fill pointer #+:lispworks @@ -194,4 +194,5 @@ (defmethod stream-write-string ((stream flexi-output-stream) string &optional (start 0) (end (length string))) "Simply hands over to the optimized method for STREAM-WRITE-SEQUENCE." + (declare #.*standard-optimize-settings*) (stream-write-sequence stream string start (or end (length string)))) Modified: branches/edi/stream.lisp ============================================================================== --- branches/edi/stream.lisp (original) +++ branches/edi/stream.lisp Mon May 19 18:59:07 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.60 2008/05/18 23:14:00 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.61 2008/05/19 22:32:56 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -74,7 +74,7 @@ "Checks whether the new value makes sense before it is set." (declare #.*standard-optimize-settings*) (unless (or (subtypep new-value 'character) - (subtypep new-value 'octet)) + (type-equal new-value 'octet)) (error 'flexi-stream-element-type-error :element-type new-value :stream flexi-stream))) Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Mon May 19 18:59:07 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.14 2008/05/19 07:57:08 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.19 2008/05/19 22:32:56 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -39,32 +39,52 @@ (setq external-format (maybe-convert-external-format external-format)) (let ((factor (encoding-factor external-format)) (length (- end start))) + (declare (fixnum length)) (etypecase factor - (float - (let ((octets (make-array (round (* factor length)) - :element-type 'octet - :fill-pointer 0 - :adjustable t))) - (flet ((writer (octet) - ;; TODO: do this manually - (vector-push-extend octet octets))) - (loop for i of-type fixnum from start below end - do (char-to-octets external-format - (char string i) - #'writer))) - octets)) (integer (let ((octets (make-array (* factor length) :element-type 'octet)) (j 0)) (declare (fixnum j)) (flet ((writer (octet) + (declare (octet octet)) (setf (aref (the (array octet *) octets) j) octet) (incf j))) + (declare (dynamic-extent (function writer))) (loop for i of-type fixnum from start below end do (char-to-octets external-format (char string i) #'writer))) - octets))))) + octets)) + (double-float + ;; this is a bit clunky but hopefully a bit more efficient than + ;; using VECTOR-PUSH-EXTEND + (let* ((octets-length (ceiling (* factor length))) + (octets (make-array octets-length + :element-type 'octet + :fill-pointer t + :adjustable t)) + (i start) + (j 0)) + (declare (fixnum i j octets-length) + (double-float factor)) + (flet ((writer (octet) + (declare (octet octet)) + (when (>= j octets-length) + (setq factor (* factor 2.0d0)) + (incf octets-length (the fixnum (ceiling (* factor (- end i))))) + (adjust-array octets octets-length :fill-pointer t)) + (setf (aref (the (array octet *) octets) j) octet) + (incf j))) + (declare (dynamic-extent (function writer))) + (loop + (when (>= i end) + (return)) + (char-to-octets external-format + (char string i) + #'writer) + (incf i)) + (setf (fill-pointer octets) j) + octets)))))) (defun octets-to-string (sequence &key (external-format (make-external-format :latin1)) @@ -80,51 +100,61 @@ (reader (etypecase sequence ((array octet *) (lambda () - (when (>= i end) - ;; TODO... -> NIL? - (error "End of data.")) - (prog1 - (aref (the (array octet *) sequence) i) - (incf i)))) + (and (= i end) - ;; TODO... - (error "End of data.")) - (prog1 - (aref sequence i) - (incf i)))) + (and (= i end) - ;; TODO... - (error "End of data.")) - (prog1 - (nth i sequence) - (incf i)))))) - (*current-unreader* (flet ((pseudo-writer (octet) - (declare (ignore octet)) - (decf i))) - (lambda (char) - (char-to-octets external-format char #'pseudo-writer))))) - (declare (fixnum i)) - (flet ((next-char () - (code-char (octets-to-char-code external-format reader)))) - (etypecase factor - (float - (let ((string (make-array (round (/ length factor)) - :element-type 'char* - :fill-pointer 0 - :adjustable t))) - (loop while (< i end) - ;; TODO: do this manually - do (vector-push-extend (next-char) string) - finally (return string)))) - (integer - (let* ((string-length (/ 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)))))))) + (and (< i end) + (prog1 + (nth i sequence) + (incf i)))))))) + (declare (fixnum i length) (dynamic-extent reader)) + (labels ((pseudo-writer (octet) + (declare (ignore octet)) + (decf i)) + (unreader (char) + (char-to-octets external-format char #'pseudo-writer))) + (declare (dynamic-extent (function pseudo-writer) (function unreader))) + (let ((*current-unreader* #'unreader)) + (flet ((next-char () + (code-char (octets-to-char-code external-format reader)))) + (declare (inline next-char)) + (etypecase factor + (integer + (let* ((string-length (/ 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)))))))) Modified: branches/edi/util.lisp ============================================================================== --- branches/edi/util.lisp (original) +++ branches/edi/util.lisp Mon May 19 18:59:07 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.17 2008/05/19 07:57:08 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.19 2008/05/19 22:32:57 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -31,7 +31,14 @@ #+:lispworks (eval-when (:compile-toplevel :load-toplevel :execute) - (import 'lw:with-unique-names)) + (import '(lw:with-unique-names lw:when-let))) + +#-:lispworks +(defmacro when-let ((var form) &body body) + "Evaluates FORM and binds VAR to the result, then executes BODY +if VAR has a true value." + `(let ((,var ,form)) + (when ,var ,@body))) #-:lispworks (defmacro with-unique-names ((&rest bindings) &body body) @@ -167,4 +174,14 @@ ;; slots `(with-slots ,(mapcar #'car slot-entries) ,instance - ,@body)) \ No newline at end of file + ,@body)) + +(defun make-octet-buffer () + "Creates and returns a fresh buffer \(a specialized array) of size ++BUFFER-SIZE+ to hold octets." + (make-array +buffer-size+ :element-type 'octet)) + +(defun type-equal (type1 type2) + "Whether TYPE1 and TYPE2 denote the same type." + (and (subtypep type1 type2) + (subtypep type2 type1))) \ No newline at end of file

1 0

[flexi-streams-cvs] r32 - branches/edi/test
by eweitz＠common-lisp.net 19 May '08

19 May '08

Author: eweitz Date: Mon May 19 15:47:40 2008 New Revision: 32 Modified: branches/edi/test/test.lisp Log: More tests Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Mon May 19 15:47:40 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.25 2008/05/19 07:57:12 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.27 2008/05/19 19:47:17 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. @@ -29,6 +29,13 @@ (in-package :flexi-streams-test) +(defconstant +buffer-size+ 8192 + "Size of buffers for COPY-STREAM* below.") + +(defvar *copy-function* nil + "Which function to use when copying from one stream to the other - +see for example COPY-FILE below.") + (defvar *this-file* (load-time-value (or #.*compile-file-pathname* *load-pathname*)) "The pathname of the file \(`test.lisp') where this variable was @@ -125,6 +132,17 @@ while line do (write-line line out)))) +(defun copy-stream* (stream-in external-format-in stream-out external-format-out) + "Like COPY-STREAM, but uses READ-SEQUENCE and WRITE-SEQUENCE instead +of READ-LINE and WRITE-LINE." + (let ((in (make-flexi-stream stream-in :external-format external-format-in)) + (out (make-flexi-stream stream-out :external-format external-format-out)) + (buffer (make-array +buffer-size+ :element-type 'flex::char*))) + (loop + (let ((position (read-sequence buffer in))) + (when (zerop position) (return)) + (write-sequence buffer out :end position))))) + (defun copy-file (path-in external-format-in path-out external-format-out direction-out direction-in) "Copies the contents of the file denoted by the pathname PATH-IN to the file denoted by the pathname PATH-OUT using flexi @@ -143,7 +161,7 @@ :direction direction-out :if-does-not-exist :create :if-exists :supersede) - (copy-stream in external-format-in out external-format-out)))) + (funcall *copy-function* in external-format-in out external-format-out)))) #+:lispworks (defun copy-file-lw (path-in external-format-in path-out external-format-out direction-out direction-in) @@ -162,7 +180,7 @@ :direction :output :if-does-not-exist :create :if-exists :supersede) - (copy-stream in external-format-in out external-format-out)))) + (funcall *copy-function* in external-format-in out external-format-out)))) (defun compare-files (path-in external-format-in path-out external-format-out) "Copies the contents of the file (in the `test') denoted by the @@ -179,7 +197,8 @@ (full-path-orig (merge-pathnames path-out *this-file*))) (dolist (direction-out '(:output :io)) (dolist (direction-in '(:input :io)) - (format *error-output* "Test ~S ~S [~A]~% --> ~S [~A].~%" path-in + (format *error-output* "Test \(using ~A) ~S ~S [~A]~% --> ~S [~A].~%" + *copy-function* 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 @@ -190,7 +209,8 @@ (t (format *error-output* " Test failed!!!~%"))) (terpri *error-output*) #+:lispworks - (format *error-output* "LW-Test ~S ~S [~A]~% --> ~S [~A].~%" path-in + (format *error-output* "LW-Test \(using ~A) ~S ~S [~A]~% --> ~S [~A].~%" + *copy-function* path-in (flex::normalize-external-format external-format-in) direction-in (flex::normalize-external-format external-format-out) direction-out) #+:lispworks @@ -331,6 +351,10 @@ (setq in (make-flexi-stream in :external-format external-format)) (read-line in))) +(defun read-flexi-line* (sequence external-format) + "Like READ-FLEXI-LINE but uses OCTETS-TO-STRING internally." + (octets-to-string sequence :external-format external-format)) + (defun error-handling-test () "Tests several possible errors and how they are handled." (with-test ("Handling of errors.") @@ -340,45 +364,71 @@ (let ((*substitution-char* #\?)) ;; :ASCII doesn't have characters with char codes > 127 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 128 200) :ascii))) + (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii))) ;; :WINDOWS-1253 doesn't have a characters with codes 170 and 210 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253))) + (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) (read-flexi-line `(,(char-code #\a) 128 200) :ascii)))) + (check (string= "abc" (using-values (#\b #\c) + (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii)))) ;; :WINDOWS-1253 encoding doesn't have a characters with codes 170 and 210 (check (string= "axy" (using-values (#\x #\y) (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253)))) + (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)))) + (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)))) ;; 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= "QW" (using-values (#\Q #\W) (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= "E" (using-values (#\E) (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)))) + (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)))) + (check (string= "T" (using-values (#\T) (read-flexi-line '(#x01 #xd8 #xff #xdb) :utf-16le)))) + (check (string= "T" (using-values (#\T) (read-flexi-line* #(#x01 #xd8 #xff #xdb) :utf-16le)))) ;; the same as for little endian above, 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)))) + (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= "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 ;; in the middle of 4-byte sequence, both for big and little endian - (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= "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= "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)))) + (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))))))) + (read-flexi-line* `#(#x00 #x00 #x00 ,(char-code #\a) #x01) :utf-32be))))))) (defun unread-char-test () "Tests whether UNREAD-CHAR behaves as expected." @@ -398,16 +448,17 @@ (defun run-tests () "Applies COMPARE-FILES to all test scenarios created with -CREATE-TEST-COMBINATIONS, runs test for handling of encoding errors, -and shows simple statistics at the end." +CREATE-TEST-COMBINATIONS, runs other tests like handling of encoding +errors, shows simple statistics at the end." (let* ((*test-success-counter* 0) (compare-files-args-list (loop for (file-name symbols) in *test-files* nconc (create-test-combinations file-name symbols))) - (no-tests (* 4 (length compare-files-args-list)))) + (no-tests (* 8 (length compare-files-args-list)))) #+:lispworks (setq no-tests (* 2 no-tests)) - (dolist (args compare-files-args-list) - (apply 'compare-files args)) + (dolist (*copy-function* '(copy-stream copy-stream*)) + (dolist (args compare-files-args-list) + (apply 'compare-files args))) (let ((string-test-args-list (loop for (file-name symbols) in *test-files* nconc (create-test-combinations file-name symbols t)))) (incf no-tests (length string-test-args-list))

1 0