[flexi-streams-cvs] r27 - in branches/edi: . test
eweitz at common-lisp.net
eweitz at common-lisp.net
Sun May 18 01:23:54 UTC 2008
Author: eweitz
Date: Sat May 17 21:23:53 2008
New Revision: 27
Modified:
branches/edi/decode.lisp
branches/edi/encode.lisp
branches/edi/external-format.lisp
branches/edi/specials.lisp
branches/edi/stream.lisp
branches/edi/strings.lisp
branches/edi/test/test.lisp
Log:
New implementation for string functions
Passes all tests
Modified: branches/edi/decode.lisp
==============================================================================
--- branches/edi/decode.lisp (original)
+++ branches/edi/decode.lisp Sat May 17 21:23:53 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.2 2008/05/17 16:35:58 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.4 2008/05/18 00:35:33 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -210,28 +210,26 @@
sum (ash octet count)))))
(defmethod octets-to-char-code ((format flexi-cr-mixin) reader unreader stream)
- "The `base' method for all streams which need end-of-line
-conversion. Uses CALL-NEXT-METHOD to do the actual work of reading
-one or more encoded characters."
(declare (optimize speed))
(let ((char-code (call-next-method)))
- (when (eq char-code :eof)
- (return-from octets-to-char-code :eof))
- (with-accessors ((eol-style external-format-eol-style))
- format
- (cond ((= char-code #.(char-code #\Return))
- (case eol-style
- (:cr #.(char-code #\Newline))
- ;; in the case :CRLF we have to look ahead one character
- (:crlf (let ((next-char-code (call-next-method)))
- (case next-char-code
- (#.(char-code #\Linefeed)
- #.(char-code #\Newline))
- (:eof char-code)
- ;; if the character we peeked at wasn't a
- ;; linefeed character we unread its constituents
- (otherwise
- (funcall unreader (code-char next-char-code))
- char-code))))))
- (t char-code)))))
+ (case char-code
+ (#.(char-code #\Return) #.(char-code #\Newline))
+ (:eof :eof)
+ (otherwise char-code))))
+
+(defmethod octets-to-char-code ((format flexi-crlf-mixin) reader unreader stream)
+ (declare (optimize speed))
+ (let ((char-code (call-next-method)))
+ (case char-code
+ (#.(char-code #\Return)
+ (let ((next-char-code (call-next-method)))
+ (case next-char-code
+ (#.(char-code #\Linefeed) #.(char-code #\Newline))
+ (:eof char-code)
+ ;; if the character we peeked at wasn't a
+ ;; linefeed character we unread its constituents
+ (otherwise (funcall unreader (code-char next-char-code))
+ char-code))))
+ (:eof :eof)
+ (t char-code))))
Modified: branches/edi/encode.lisp
==============================================================================
--- branches/edi/encode.lisp (original)
+++ branches/edi/encode.lisp Sat May 17 21:23:53 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.2 2008/05/17 16:35:58 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.4 2008/05/18 00:35:33 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -42,16 +42,14 @@
(let ((octet (char-code char)))
(when (> octet 255)
(signal-encoding-error stream "~S is not a LATIN-1 character." char))
- (funcall writer octet))
- char)
+ (funcall writer octet)))
(defmethod char-to-octets ((format flexi-ascii-format) char writer stream)
(declare (optimize speed))
(let ((octet (char-code char)))
(when (> octet 127)
(signal-encoding-error stream "~S is not an ASCII character." char))
- (funcall writer octet))
- char)
+ (funcall writer octet)))
(defmethod char-to-octets ((format flexi-8-bit-format) char writer stream)
(declare (optimize speed))
@@ -60,8 +58,7 @@
(let ((octet (gethash (char-code char) encoding-hash)))
(unless octet
(signal-encoding-error stream "~S is not in this encoding." char))
- (funcall writer octet))
- char))
+ (funcall writer octet))))
(defmethod char-to-octets ((format flexi-utf-8-format) char writer stream)
(declare (ignore stream) (optimize speed))
@@ -92,8 +89,7 @@
(funcall writer (logior #b10000000 (ldb (byte 6 6) char-code)))
one
(funcall writer (logior #b10000000 (ldb (byte 6 0) char-code)))
- zero))
- char)
+ zero)))
(defmethod char-to-octets ((format flexi-utf-16-le-format) char writer stream)
(declare (ignore stream) (optimize speed))
@@ -105,8 +101,7 @@
(write-word char-code))
(t (decf char-code #x10000)
(write-word (logior #xd800 (ldb (byte 10 10) char-code)))
- (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))
- char)
+ (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))))
(defmethod char-to-octets ((format flexi-utf-16-be-format) char writer stream)
(declare (ignore stream) (optimize speed))
@@ -119,33 +114,29 @@
(write-word char-code))
(t (decf char-code #x10000)
(write-word (logior #xd800 (ldb (byte 10 10) char-code)))
- (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))
- char)
+ (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))))
(defmethod char-to-octets ((format flexi-utf-32-le-format) char writer stream)
(declare (ignore stream) (optimize speed))
(loop with char-code = (char-code char)
for position in '(0 8 16 24) do
- (funcall writer (ldb (byte 8 position) char-code)))
- char)
+ (funcall writer (ldb (byte 8 position) char-code))))
(defmethod char-to-octets ((format flexi-utf-32-be-format) char writer stream)
(declare (ignore stream) (optimize speed))
(loop with char-code = (char-code char)
for position in '(24 16 8 0) do
- (funcall writer (ldb (byte 8 position) char-code)))
- char)
+ (funcall writer (ldb (byte 8 position) char-code))))
(defmethod char-to-octets ((format flexi-cr-mixin) char writer stream)
- "The `base' method for all formats which need end-of-line
-conversion. Uses CALL-NEXT-METHOD to do the actual work of sending
-one or more characters to SINK."
(declare (optimize speed))
- (case char
- (#\Newline
- (case (external-format-eol-style format)
- (:cr (call-next-method format #\Return writer stream))
- (:crlf (call-next-method format #\Return writer stream)
- (call-next-method format #\Linefeed writer stream))))
- (otherwise (call-next-method)))
- char)
+ (if (char= char #\Newline)
+ (call-next-method format #\Return writer stream)
+ (call-next-method)))
+
+(defmethod char-to-octets ((format flexi-crlf-mixin) char writer stream)
+ (declare (optimize speed))
+ (cond ((char= char #\Newline)
+ (call-next-method format #\Return writer stream)
+ (call-next-method format #\Linefeed writer stream))
+ (t (call-next-method))))
Modified: branches/edi/external-format.lisp
==============================================================================
--- branches/edi/external-format.lisp (original)
+++ branches/edi/external-format.lisp Sat May 17 21:23:53 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.15 2008/05/17 16:38:24 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.17 2008/05/18 00:34:19 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -60,9 +60,13 @@
(defclass flexi-cr-mixin ()
()
- (:documentation "A mixin for external-formats which need
-end-of-line conversion, i.e. for those where the end-of-line
-designator is /not/ the single character #\Linefeed."))
+ (:documentation "A mixin for external-formats where the end-of-line
+designator is #\Return."))
+
+(defclass flexi-crlf-mixin ()
+ ()
+ (:documentation "A mixin for external-formats where the end-of-line
+designator is the sequence #\Return #\Linefeed."))
(defclass flexi-8-bit-format (external-format)
((encoding-hash :accessor external-format-encoding-hash)
@@ -72,9 +76,10 @@
tables."))
(defclass flexi-cr-8-bit-format (flexi-cr-mixin flexi-8-bit-format)
- ()
- (:documentation "The class for all external formats which use an
-8-bit encoding /and/ need end-of-line conversion."))
+ ())
+
+(defclass flexi-crlf-8-bit-format (flexi-crlf-mixin flexi-8-bit-format)
+ ())
(defclass flexi-ascii-format (flexi-8-bit-format)
()
@@ -82,9 +87,10 @@
US-ASCCI encoding."))
(defclass flexi-cr-ascii-format (flexi-cr-mixin flexi-ascii-format)
- ()
- (:documentation "Special class for external formats which use the
-US-ASCCI encoding /and/ need end-of-line conversion."))
+ ())
+
+(defclass flexi-crlf-ascii-format (flexi-crlf-mixin flexi-ascii-format)
+ ())
(defclass flexi-latin-1-format (flexi-8-bit-format)
()
@@ -92,53 +98,64 @@
ISO-8859-1 encoding."))
(defclass flexi-cr-latin-1-format (flexi-cr-mixin flexi-latin-1-format)
+ ())
+
+(defclass flexi-crlf-latin-1-format (flexi-crlf-mixin flexi-latin-1-format)
+ ())
+
+(defclass flexi-utf-32-format (external-format)
()
- (:documentation "Special class for external formats which use the
-ISO-8859-1 encoding /and/ need end-of-line conversion."))
+ (:documentation "Abstract class for external formats which use the
+UTF-32 encoding."))
-(defclass flexi-utf-32-le-format (external-format)
+(defclass flexi-utf-32-le-format (flexi-utf-32-format)
()
(:documentation "Special class for external formats which use the
UTF-32 encoding with little-endian byte ordering."))
(defclass flexi-cr-utf-32-le-format (flexi-cr-mixin flexi-utf-32-le-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-32 encoding with little-endian byte ordering /and/ need
-end-of-line conversion."))
+ ())
-(defclass flexi-utf-32-be-format (external-format)
+(defclass flexi-crlf-utf-32-le-format (flexi-crlf-mixin flexi-utf-32-le-format)
+ ())
+
+(defclass flexi-utf-32-be-format (flexi-utf-32-format)
()
(:documentation "Special class for external formats which use the
UTF-32 encoding with big-endian byte ordering."))
(defclass flexi-cr-utf-32-be-format (flexi-cr-mixin flexi-utf-32-be-format)
+ ())
+
+(defclass flexi-crlf-utf-32-be-format (flexi-crlf-mixin flexi-utf-32-be-format)
+ ())
+
+(defclass flexi-utf-16-format (external-format)
()
- (:documentation "Special class for external formats which use the
-UTF-32 encoding with big-endian byte ordering /and/ need end-of-line
-conversion."))
+ (:documentation "Abstract class for external formats which use the
+UTF-16 encoding."))
-(defclass flexi-utf-16-le-format (external-format)
+(defclass flexi-utf-16-le-format (flexi-utf-16-format)
()
(:documentation "Special class for external formats which use the
UTF-16 encoding with little-endian byte ordering."))
(defclass flexi-cr-utf-16-le-format (flexi-cr-mixin flexi-utf-16-le-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-16 encoding with little-endian byte ordering /and/ need
-end-of-line conversion."))
+ ())
-(defclass flexi-utf-16-be-format (external-format)
+(defclass flexi-crlf-utf-16-le-format (flexi-crlf-mixin flexi-utf-16-le-format)
+ ())
+
+(defclass flexi-utf-16-be-format (flexi-utf-16-format)
()
(:documentation "Special class for external formats which use the
UTF-16 encoding with big-endian byte ordering."))
(defclass flexi-cr-utf-16-be-format (flexi-cr-mixin flexi-utf-16-be-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-16 encoding with big-endian byte ordering /and/ need end-of-line
-conversion."))
+ ())
+
+(defclass flexi-crlf-utf-16-be-format (flexi-crlf-mixin flexi-utf-16-be-format)
+ ())
(defclass flexi-utf-8-format (external-format)
()
@@ -146,9 +163,10 @@
UTF-8 encoding."))
(defclass flexi-cr-utf-8-format (flexi-cr-mixin flexi-utf-8-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-8 encoding /and/ need end-of-line conversion."))
+ ())
+
+(defclass flexi-crlf-utf-8-format (flexi-crlf-mixin flexi-utf-8-format)
+ ())
(defmethod initialize-instance :after ((external-format flexi-8-bit-format) &rest initargs)
"Sets the fixed encoding/decoding tables for this particular
@@ -171,40 +189,50 @@
(values (cdr (assoc id +code-page-hashes+))
(cdr (assoc id +code-page-tables+))))))))
-(defun external-format-class-name (real-name eol-style little-endian)
- (let ((crp (not (eq eol-style :lf))))
- (cond ((ascii-name-p real-name)
- (if crp
- 'flexi-cr-ascii-format
- 'flexi-ascii-format))
- ((eq real-name :iso-8859-1)
- (if crp
- 'flexi-cr-latin-1-format
- 'flexi-latin-1-format))
- ((or (koi8-r-name-p real-name)
- (iso-8859-name-p real-name)
- (code-page-name-p real-name))
- (if crp
- 'flexi-cr-8-bit-format
- 'flexi-8-bit-format))
- (t (case real-name
- (:utf-8 (if crp
- 'flexi-cr-utf-8-format
- 'flexi-utf-8-format))
- (:utf-16 (if crp
- (if little-endian
- 'flexi-cr-utf-16-le-format
- 'flexi-cr-utf-16-be-format)
- (if little-endian
- 'flexi-utf-16-le-format
- 'flexi-utf-16-be-format)))
- (:utf-32 (if crp
- (if little-endian
- 'flexi-cr-utf-32-le-format
- 'flexi-cr-utf-32-be-format)
- (if little-endian
- 'flexi-utf-32-le-format
- 'flexi-utf-32-be-format))))))))
+(defun external-format-class-name (real-name &key eol-style little-endian id)
+ (declare (ignore id))
+ (cond ((ascii-name-p real-name)
+ (ecase eol-style
+ (:lf 'flexi-ascii-format)
+ (:cr 'flexi-cr-ascii-format)
+ (:crlf 'flexi-crlf-ascii-format)))
+ ((eq real-name :iso-8859-1)
+ (ecase eol-style
+ (:lf 'flexi-latin-1-format)
+ (:cr 'flexi-cr-latin-1-format)
+ (:crlf 'flexi-crlf-latin-1-format)))
+ ((or (koi8-r-name-p real-name)
+ (iso-8859-name-p real-name)
+ (code-page-name-p real-name))
+ (ecase eol-style
+ (:lf 'flexi-8-bit-format)
+ (:cr 'flexi-cr-8-bit-format)
+ (:crlf 'flexi-crlf-8-bit-format)))
+ (t (ecase real-name
+ (:utf-8 (ecase eol-style
+ (:lf 'flexi-utf-8-format)
+ (:cr 'flexi-cr-utf-8-format)
+ (:crlf 'flexi-crlf-utf-8-format)))
+ (:utf-16 (ecase eol-style
+ (:lf (if little-endian
+ 'flexi-utf-16-le-format
+ 'flexi-utf-16-be-format))
+ (:cr (if little-endian
+ 'flexi-cr-utf-16-le-format
+ 'flexi-cr-utf-16-be-format))
+ (:crlf (if little-endian
+ 'flexi-crlf-utf-16-le-format
+ 'flexi-crlf-utf-16-be-format))))
+ (:utf-32 (ecase eol-style
+ (:lf (if little-endian
+ 'flexi-utf-32-le-format
+ 'flexi-utf-32-be-format))
+ (:cr (if little-endian
+ 'flexi-cr-utf-32-le-format
+ 'flexi-cr-utf-32-be-format))
+ (:crlf (if little-endian
+ 'flexi-crlf-utf-32-le-format
+ 'flexi-crlf-utf-32-be-format))))))))
(defun make-external-format% (name &key (little-endian *default-little-endian*)
id eol-style)
@@ -222,7 +250,7 @@
:eol-style (or eol-style :crlf)))
(t (list :eol-style (or eol-style *default-eol-style*)
:little-endian little-endian)))))
- (apply #'make-instance (external-format-class-name real-name eol-style little-endian)
+ (apply #'make-instance (apply #'external-format-class-name real-name initargs)
:name real-name
initargs)))
@@ -242,6 +270,15 @@
(append shortcut-args
`(:eol-style ,eol-style))))
(t (apply #'make-external-format% name args)))))
+
+(defun maybe-convert-external-format (external-format)
+ "Given an external format designator \(a keyword, a list, or an
+EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT
+object."
+ (typecase external-format
+ (symbol (make-external-format external-format))
+ (list (apply #'make-external-format external-format))
+ (otherwise external-format)))
(defun external-format-equal (ef1 ef2)
"Checks whether two EXTERNAL-FORMAT objects denote the same
@@ -292,4 +329,21 @@
"How an EXTERNAL-FORMAT object is rendered. Uses
NORMALIZE-EXTERNAL-FORMAT."
(print-unreadable-object (object stream :type t :identity t)
- (prin1 (normalize-external-format object) stream)))
\ No newline at end of file
+ (prin1 (normalize-external-format object) stream)))
+
+(defgeneric encoding-factor (format))
+
+(defmethod encoding-factor ((format flexi-8-bit-format))
+ 1)
+
+(defmethod encoding-factor ((format flexi-utf-8-format))
+ 1.05)
+
+(defmethod encoding-factor ((format flexi-utf-16-format))
+ 2.0)
+
+(defmethod encoding-factor ((format flexi-utf-32-format))
+ 4)
+
+(defmethod encoding-factor ((format flexi-crlf-mixin))
+ (* 1.02 (call-next-method)))
\ No newline at end of file
Modified: branches/edi/specials.lisp
==============================================================================
--- branches/edi/specials.lisp (original)
+++ branches/edi/specials.lisp Sat May 17 21:23:53 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.26 2008/05/17 13:50:16 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.27 2008/05/18 01:21:34 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -33,6 +33,12 @@
"A shortcut for \(UNSIGNED-BYTE 8)."
'(unsigned-byte 8))
+(deftype char* ()
+ "Convenience shortcut to paper over the difference between LispWorks
+and the other Lisps."
+ #+:lispworks 'lw:simple-char
+ #-:lispworks 'character)
+
(defvar +name-map+
'((:utf8 . :utf-8)
(:utf16 . :utf-16)
Modified: branches/edi/stream.lisp
==============================================================================
--- branches/edi/stream.lisp (original)
+++ branches/edi/stream.lisp Sat May 17 21:23:53 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.57 2008/05/17 14:21:20 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.59 2008/05/18 01:21:34 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -40,7 +40,7 @@
:accessor flexi-stream-external-format
:documentation "The encoding currently used
by this stream. Can be changed on the fly.")
- (element-type :initform #+:lispworks 'lw:simple-char #-:lispworks 'character
+ (element-type :initform 'char*
:initarg :element-type
:accessor flexi-stream-element-type
:documentation "The element type of this stream."))
@@ -49,15 +49,6 @@
allow for multi-octet external formats. FLEXI-STREAM itself is a
mixin and should not be instantiated."))
-(defun maybe-convert-external-format (external-format)
- "Given an external format designator \(a keyword, a list, or an
-EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT
-object."
- (typecase external-format
- (symbol (make-external-format external-format))
- (list (apply #'make-external-format external-format))
- (otherwise external-format)))
-
(defmethod initialize-instance :after ((flexi-stream flexi-stream) &rest initargs)
"Makes sure the EXTERNAL-FORMAT and ELEMENT-TYPE slots contain
reasonable values."
Modified: branches/edi/strings.lisp
==============================================================================
--- branches/edi/strings.lisp (original)
+++ branches/edi/strings.lisp Sat May 17 21:23:53 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.5 2008/05/17 13:50:16 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.8 2008/05/18 01:21:34 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -29,28 +29,80 @@
(in-package :flexi-streams)
-(defun string-to-octets (string &key (external-format (make-external-format :latin1))
- (start 0) end)
+(defun string-to-octets (string &key
+ (external-format (make-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."
- (declare (optimize speed))
- (with-output-to-sequence (out)
- (let ((flexi (make-flexi-stream out :external-format external-format)))
- (write-string string flexi :start start :end end))))
-
-(defun octets-to-string (vector &key (external-format (make-external-format :latin1))
- (start 0) (end (length vector)))
+ (setq external-format (maybe-convert-external-format external-format))
+ (let ((factor (encoding-factor external-format))
+ (length (- end start)))
+ (etypecase factor
+ (float
+ (let ((octets (make-array (round (* factor length))
+ :element-type 'octet
+ :fill-pointer 0
+ :adjustable t)))
+ (loop for i from start below end
+ do (char-to-octets external-format
+ (char string i)
+ (lambda (octet)
+ (vector-push-extend octet octets))
+ nil))
+ octets))
+ (integer
+ (let ((octets (make-array (* factor length)
+ :element-type 'octet)))
+ (loop with j = 0
+ for i from start below end
+ do (char-to-octets external-format
+ (char string i)
+ (lambda (octet)
+ (setf (aref octets j) octet)
+ (incf j))
+ nil))
+ octets)))))
+
+(defun octets-to-string (vector &key
+ (external-format (make-external-format :latin1))
+ (start 0) (end (length vector)))
"Converts the Lisp vector VECTOR of octets from START to END to
string using the external format EXTERNAL-FORMAT."
- (declare (optimize speed))
- (with-input-from-sequence (in vector :start start :end end)
- (let ((flexi (make-flexi-stream in :external-format external-format))
- (result (make-array (- end start)
- :element-type #+:lispworks 'lw:simple-char
- #-:lispworks 'character
- :fill-pointer t)))
- (setf (fill-pointer result)
- (read-sequence result flexi))
- result)))
-
-
+ (setq external-format (maybe-convert-external-format external-format))
+ (let ((factor (encoding-factor external-format))
+ (length (- end start))
+ (i start))
+ (flet ((next-char ()
+ (code-char
+ (octets-to-char-code external-format
+ (lambda ()
+ (when (>= i end)
+ ;; TODO...
+ (error "End of data."))
+ (prog1
+ (aref vector i)
+ (incf i)))
+ (lambda (char)
+ (char-to-octets external-format
+ char
+ (lambda (octet)
+ (declare (ignore octet))
+ (decf i))
+ nil))
+ nil))))
+ (etypecase factor
+ (float
+ (let ((string (make-array (round (/ length factor))
+ :element-type 'char*
+ :fill-pointer 0
+ :adjustable t)))
+ (loop while (< i end)
+ do (vector-push-extend (next-char) string)
+ finally (return string))))
+ (integer
+ (let* ((string-length (/ length factor))
+ (string (make-array string-length
+ :element-type 'char*)))
+ (loop for j from 0 below string-length
+ do (setf (char string j) (next-char))
+ finally (return string))))))))
Modified: branches/edi/test/test.lisp
==============================================================================
--- branches/edi/test/test.lisp (original)
+++ branches/edi/test/test.lisp Sat May 17 21:23:53 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.20 2008/05/17 13:50:18 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.21 2008/05/18 01:21:36 edi Exp $
;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
@@ -263,12 +263,10 @@
that the stream conversion functions work."
(let* ((full-path (merge-pathnames pathspec *this-file*))
(octets-vector (file-as-octet-vector full-path))
- (octets-list (coerce octets-vector 'list))
(string (file-as-string full-path external-format)))
(with-test ((format nil "String tests with format ~S."
(flex::normalize-external-format external-format)))
(check (string= (octets-to-string octets-vector :external-format external-format) string))
- (check (string= (octets-to-string octets-list :external-format external-format) string))
(check (equalp (string-to-octets string :external-format external-format) octets-vector)))))
(defmacro using-values ((&rest values) &body body)
More information about the Flexi-streams-cvs
mailing list