1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
3 ;;; --- iolib.streams test suite.
5 ;;; Copyright (c) 2006-2007, Dr. Edmund Weitz. All rights reserved.
6 ;;; Copyright (c) 2007, Luis Oliveira <loliveira@common-lisp.net>
8 ;;; Redistribution and use in source and binary forms, with or without
9 ;;; modification, are permitted provided that the following conditions
12 ;;; * Redistributions of source code must retain the above copyright
13 ;;; notice, this list of conditions and the following disclaimer.
15 ;;; * Redistributions in binary form must reproduce the above
16 ;;; copyright notice, this list of conditions and the following
17 ;;; disclaimer in the documentation and/or other materials
18 ;;; provided with the distribution.
20 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
21 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
22 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
24 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
26 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
27 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
28 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
29 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
30 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 (in-package :iolib-tests
)
34 (in-suite :iolib.streams
)
36 (defclass my-file-stream
(dual-channel-gray-stream)
37 ((path :initarg
:path
:reader file-stream-path
)))
39 ;;; Very ad-hoc: doesn't do :DIRECTION :PROBE, or handle errors,
40 ;;; :IF-DOES-NOT-EXIST, among many other things. This kind of thing
41 ;;; should be moved into OSICAT, btw.
43 ;;; FIXME: implement single-channel stream
44 (defun make-file-stream (path &key
47 (if-does-not-exist (ecase direction
49 ((:io
:output
) :create
)))
50 (external-format :default
))
51 (declare (ignore if-does-not-exist
))
52 ;; move OPEN to INITIALIZE-INSTANCE
53 (let ((fd (isys:open
(namestring path
)
54 (logior (ecase direction
55 (:input isys
:o-rdonly
)
56 (:output
(logior isys
:o-creat isys
:o-wronly
))
57 (:io
(logior isys
:o-creat isys
:o-rdwr
)))
60 (:supersede isys
:o-trunc
)
61 (:append isys
:o-append
)
63 (logior isys
:s-irusr isys
:s-iwusr
))))
64 (setf (isys:fd-nonblock-p fd
) t
)
65 (make-instance 'my-file-stream
68 :external-format external-format
)))
70 (defmacro with-open-file-stream
((var path
&rest options
) &body body
)
71 (with-gensyms (stream)
72 `(let ((,stream
(make-file-stream ,path
,@options
)))
73 (with-open-stream (,var
,stream
)
77 (asdf:system-relative-pathname
"iolib" "tests/data/"))
80 (asdf:apply-output-translations
81 (asdf:system-relative-pathname
"iolib" "tests/test-dir/")))
83 ;;; A list of test files where each entry consists of the name
84 ;;; prefix and a list of encodings.
86 '(("kafka" (#-
8bit-chars
:utf-8
:latin-1
#|
:cp1252|
#))
87 ("tilton" (#-
8bit-chars
:utf-8
:ascii
))
88 ("hebrew" (#-
8bit-chars
:utf-8
#|
:latin-8|
#))
89 ("russian" (#-
8bit-chars
:utf-8
#|
:koi8r|
#))
90 ("unicode_demo" (#-
8bit-chars
:utf-8
#|
:utf-16
:utf-32|
#))))
92 ;;; For a name suffix FILE-NAME and a symbol SYMBOL denoting an
93 ;;; encoding returns a list of pairs where the car is a full file name
94 ;;; and the cdr is the corresponding external format. This list
95 ;;; contains all possible line-end conversions.
96 (defun create-file-variants (file-name symbol
)
97 (loop :for eol-style
:in
'(:lf
:cr
:crlf
) :collect
98 (cons (format nil
"~A_~(~A~)_~(~A~).txt"
99 file-name symbol eol-style
)
100 (babel:make-external-format symbol
:eol-style eol-style
))))
102 ;;; For a name suffix FILE-NAME and a list of symbols SYMBOLS denoting
103 ;;; different encodings of the corresponding file returns a list of
104 ;;; lists which can be used as arglists for COMPARE-FILES.
105 (defun create-test-combinations (file-name symbols
)
106 (let ((file-variants (loop :for symbol
:in symbols
107 :nconc
(create-file-variants file-name symbol
))))
108 (loop :for
(name-in . external-format-in
) :in file-variants
109 :nconc
(loop :for
(name-out . external-format-out
) :in file-variants
110 :collect
(list name-in external-format-in
111 name-out external-format-out
)))))
113 ;;; Returns a true value iff FILE1 and FILE2 have the same contents
114 ;;; (viewed as binary files).
115 (defun file-equal (file1 file2
)
116 (with-open-file (stream1 file1
:element-type
'(unsigned-byte 8))
117 (with-open-file (stream2 file2
:element-type
'(unsigned-byte 8))
118 (and (= (file-length stream1
) (file-length stream2
))
119 (loop :for byte1
:= (read-byte stream1 nil nil
)
120 :for byte2
:= (read-byte stream2 nil nil
)
121 :while
(and byte1 byte2
)
122 :always
(= byte1 byte2
))))))
124 ;;; Copies the contents of the file denoted by the pathname PATH-IN to
125 ;;; the file denoted by the pathname PATH-OUT using flexi streams -
126 ;;; STREAM-IN is read with the external format EXTERNAL-FORMAT-IN and
127 ;;; STREAM-OUT is written with EXTERNAL-FORMAT-OUT. The input file is
128 ;;; opened with the :DIRECTION keyword argument DIRECTION-IN, the
129 ;;; output file is opened with the :DIRECTION keyword argument
131 (defun %copy-file
(path-in external-format-in path-out external-format-out
132 direction-out direction-in
)
133 (with-open-file-stream (in path-in
134 :direction direction-in
135 :if-does-not-exist
:error
136 :if-exists
:overwrite
137 :external-format external-format-in
)
138 (with-open-file-stream (out path-out
139 :direction direction-out
140 :if-does-not-exist
:create
141 :if-exists
:supersede
142 :external-format external-format-out
)
143 (loop :for line
:= (read-line in nil nil
)
144 :while line
:do
(write-line line out
)))))
148 (babel-encodings:enc-name
(babel:external-format-encoding ef
))
149 (babel:external-format-eol-style ef
)))
151 ;;; Copies the contents of the file (in the 'test') denoted by the
152 ;;; relative pathname PATH-IN to the file (in a temporary directory)
153 ;;; denoted by the relative pathname PATH-OUT using flexi streams -
154 ;;; STREAM-IN is read with the external format EXTERNAL-FORMAT-IN and
155 ;;; STREAM-OUT is written with EXTERNAL-FORMAT-OUT. The resulting
156 ;;; file is compared with an existing file in the 'test' directory to
157 ;;; check if the outcome is as expected. Uses various variants of the
158 ;;; :DIRECTION keyword when opening the files."
159 (defun compare-files (path-in external-format-in path-out external-format-out
)
160 (ensure-directories-exist *test-dir
*)
161 (let ((full-path-in (merge-pathnames path-in
*data-dir
*))
162 (full-path-out (merge-pathnames path-out
*test-dir
*))
163 (full-path-orig (merge-pathnames path-out
*data-dir
*)))
164 (dolist (direction-out '(:output
:io
) t
)
165 (dolist (direction-in '(:input
:io
))
166 (let ((description (format nil
"Test ~S ~A [~A] --> ~A [~A]"
167 path-in
(ef-name external-format-in
)
168 direction-in
(ef-name external-format-out
)
170 (format *error-output
* "~&;; ~A.~%" description
)
171 (%copy-file full-path-in external-format-in
172 full-path-out external-format-out
173 direction-out direction-in
)
174 (unless (file-equal full-path-out full-path-orig
)
175 (format *error-output
* "~&;; Test failed!!!~%")
178 (test (big-stream-comparision-test :compile-at
:definition-time
)
180 (let ((args-list (loop :for
(file-name symbols
) :in
*test-files
*
181 :nconc
(create-test-combinations file-name symbols
))))
182 (loop :for args
:in args-list
183 :unless
(apply #'compare-files args
)