[flexi-streams-cvs] r32 - branches/edi/test
eweitz at common-lisp.net
eweitz at common-lisp.net
Mon May 19 19:47:41 UTC 2008
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))
More information about the Flexi-streams-cvs
mailing list