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))