[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