/[flexi-streams]/branches/edi/test/test.lisp
ViewVC logotype

Contents of /branches/edi/test/test.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 61 - (show annotations)
Sun May 25 23:43:22 2008 UTC (5 years, 10 months ago) by eweitz
File size: 32560 byte(s)
Ready for release
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*-
2 ;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.35 2008/05/25 23:10:47 edi Exp $
3
4 ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
5
6 ;;; Redistribution and use in source and binary forms, with or without
7 ;;; modification, are permitted provided that the following conditions
8 ;;; are met:
9
10 ;;; * Redistributions of source code must retain the above copyright
11 ;;; notice, this list of conditions and the following disclaimer.
12
13 ;;; * Redistributions in binary form must reproduce the above
14 ;;; copyright notice, this list of conditions and the following
15 ;;; disclaimer in the documentation and/or other materials
16 ;;; provided with the distribution.
17
18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
30 (in-package :flexi-streams-test)
31
32 (defmacro with-test ((test-description) &body body)
33 "Defines a test. Two utilities are available inside of the body of
34 the maco: The function FAIL, and the macro CHECK. FAIL, the lowest
35 level utility, marks the test defined by WITH-TEST as failed. CHECK
36 checks whether its argument is true, otherwise it calls FAIL. If
37 during evaluation of the specified expression any condition is
38 signalled, this is also considered a failure.
39
40 WITH-TEST prints reports while the tests run. It also increments
41 *TEST-SUCCESS-COUNT* if a test completes successfully."
42 (flex::with-unique-names (successp)
43 `(let ((,successp t))
44 (flet ((fail (format-str &rest format-args)
45 (setf ,successp nil)
46 (apply #'format *error-output* format-str format-args)))
47 (macrolet ((check (expression)
48 `(handler-case
49 (unless ,expression
50 (fail "Expression ~S failed.~%" ',expression))
51 (error (c)
52 (fail "Expression ~S failed signalling error of type ~A: ~A.~%"
53 ',expression (type-of c) c))))
54 (with-expected-error ((condition-type) &body body)
55 `(handler-case (progn ,@body)
56 (,condition-type () t)
57 (:no-error (&rest args)
58 (declare (ignore args))
59 (fail "Expected condition ~S not signalled~%"
60 ',condition-type)))))
61 (format *error-output* "Test ~S~%" ,test-description)
62 ,@body
63 (if ,successp
64 (incf *test-success-counter*)
65 (format *error-output* " Test failed!!!~%"))
66 (terpri *error-output*)
67 (terpri *error-output*))
68 ,successp))))
69
70 ;; LW can't indent this correctly because it's in a MACROLET
71 #+:lispworks
72 (editor:setup-indent "with-expected-error" 1 2 4)
73
74 (defconstant +buffer-size+ 8192
75 "Size of buffers for COPY-STREAM* below.")
76
77 (defvar *copy-function* nil
78 "Which function to use when copying from one stream to the other -
79 see for example COPY-FILE below.")
80
81 (defvar *this-file* (load-time-value
82 (or #.*compile-file-pathname* *load-pathname*))
83 "The pathname of the file \(`test.lisp') where this variable was
84 defined.")
85
86 #+:lispworks
87 (defun get-env-variable-as-directory (name)
88 (lw:when-let (string (lw:environment-variable name))
89 (when (plusp (length string))
90 (cond ((find (char string (1- (length string))) "\\/" :test #'char=) string)
91 (t (lw:string-append string "/"))))))
92
93 (defvar *tmp-dir*
94 (load-time-value
95 (merge-pathnames "odd-streams-test/"
96 #+:allegro (system:temporary-directory)
97 #+:lispworks (pathname (or (get-env-variable-as-directory "TEMP")
98 (get-env-variable-as-directory "TMP")
99 #+:win32 "C:/"
100 #-:win32 "/tmp/"))
101 #-(or :allegro :lispworks) #p"/tmp/"))
102 "The pathname of a temporary directory used for testing.")
103
104 (defvar *test-files*
105 '(("kafka" (:utf8 :latin1 :cp1252))
106 ("tilton" (:utf8 :ascii))
107 ("hebrew" (:utf8 :latin8))
108 ("russian" (:utf8 :koi8r))
109 ("unicode_demo" (:utf8 :ucs2 :ucs4)))
110 "A list of test files where each entry consists of the name
111 prefix and a list of encodings.")
112
113 (defvar *test-success-counter* 0
114 "Counts the number of successful tests.")
115
116 (defun create-file-variants (file-name symbol)
117 "For a name suffix FILE-NAME and a symbol SYMBOL denoting an
118 encoding returns a list of pairs where the car is a full file
119 name and the cdr is the corresponding external format. This list
120 contains all possible variants w.r.t. to line-end conversion and
121 endianness."
122 (let ((args (ecase symbol
123 (:ascii '(:ascii))
124 (:latin1 '(:latin-1))
125 (:latin8 '(:hebrew))
126 (:cp1252 '(:code-page :id 1252))
127 (:koi8r '(:koi8-r))
128 (:utf8 '(:utf-8))
129 (:ucs2 '(:utf-16))
130 (:ucs4 '(:utf-32))))
131 (endianp (member symbol '(:ucs2 :ucs4))))
132 (loop for little-endian in (if endianp '(t nil) '(t))
133 for endian-suffix in (if endianp '("_le" "_be") '(""))
134 nconc (loop for eol-style in '(:lf :cr :crlf)
135 collect (cons (format nil "~A_~(~A~)_~(~A~)~A.txt"
136 file-name symbol eol-style endian-suffix)
137 (apply #'make-external-format
138 (append args `(:eol-style ,eol-style
139 :little-endian ,little-endian))))))))
140
141 (defun create-test-combinations (file-name symbols &optional simplep)
142 "For a name suffix FILE-NAME and a list of symbols SYMBOLS denoting
143 different encodings of the corresponding file returns a list of lists
144 which can be used as arglists for COMPARE-FILES. If SIMPLEP is true,
145 a list which can be used for the string tests below is returned."
146 (let ((file-variants (loop for symbol in symbols
147 nconc (create-file-variants file-name symbol))))
148 (loop for (name-in . external-format-in) in file-variants
149 when simplep
150 collect (list name-in external-format-in)
151 else
152 nconc (loop for (name-out . external-format-out) in file-variants
153 collect (list name-in external-format-in name-out external-format-out)))))
154
155 (defun file-equal (file1 file2)
156 "Returns a true value iff FILE1 and FILE2 have the same
157 contents \(viewed as binary files)."
158 (with-open-file (stream1 file1 :element-type 'octet)
159 (with-open-file (stream2 file2 :element-type 'octet)
160 (and (= (file-length stream1) (file-length stream2))
161 (loop for byte1 = (read-byte stream1 nil nil)
162 for byte2 = (read-byte stream2 nil nil)
163 while (and byte1 byte2)
164 always (= byte1 byte2))))))
165
166 (defun copy-stream (stream-in external-format-in stream-out external-format-out)
167 "Copies the contents of the binary stream STREAM-IN to the
168 binary stream STREAM-OUT using flexi streams - STREAM-IN is read
169 with the external format EXTERNAL-FORMAT-IN and STREAM-OUT is
170 written with EXTERNAL-FORMAT-OUT."
171 (let ((in (make-flexi-stream stream-in :external-format external-format-in))
172 (out (make-flexi-stream stream-out :external-format external-format-out)))
173 (loop for line = (read-line in nil nil)
174 while line
175 do (write-line line out))))
176
177 (defun copy-stream* (stream-in external-format-in stream-out external-format-out)
178 "Like COPY-STREAM, but uses READ-SEQUENCE and WRITE-SEQUENCE instead
179 of READ-LINE and WRITE-LINE."
180 (let ((in (make-flexi-stream stream-in :external-format external-format-in))
181 (out (make-flexi-stream stream-out :external-format external-format-out))
182 (buffer (make-array +buffer-size+ :element-type 'flex::char*)))
183 (loop
184 (let ((position (read-sequence buffer in)))
185 (when (zerop position) (return))
186 (write-sequence buffer out :end position)))))
187
188 (defun copy-file (path-in external-format-in path-out external-format-out direction-out direction-in)
189 "Copies the contents of the file denoted by the pathname
190 PATH-IN to the file denoted by the pathname PATH-OUT using flexi
191 streams - STREAM-IN is read with the external format
192 EXTERNAL-FORMAT-IN and STREAM-OUT is written with
193 EXTERNAL-FORMAT-OUT. The input file is opened with
194 the :DIRECTION keyword argument DIRECTION-IN, the output file is
195 opened with the :DIRECTION keyword argument DIRECTION-OUT."
196 (with-open-file (in path-in
197 :element-type 'octet
198 :direction direction-in
199 :if-does-not-exist :error
200 :if-exists :overwrite)
201 (with-open-file (out path-out
202 :element-type 'octet
203 :direction direction-out
204 :if-does-not-exist :create
205 :if-exists :supersede)
206 (funcall *copy-function* in external-format-in out external-format-out))))
207
208 #+:lispworks
209 (defun copy-file-lw (path-in external-format-in path-out external-format-out direction-out direction-in)
210 "Same as COPY-FILE, but uses character streams instead of
211 binary streams. Only used to test LispWorks-specific behaviour."
212 (with-open-file (in path-in
213 :external-format '(:latin-1 :eol-style :lf)
214 :element-type 'base-char
215 :direction direction-in
216 :if-does-not-exist :error
217 :if-exists :overwrite)
218 (with-open-file (out path-out
219 :external-format '(:latin-1 :eol-style :lf)
220 :element-type 'base-char
221 :direction direction-out
222 :direction :output
223 :if-does-not-exist :create
224 :if-exists :supersede)
225 (funcall *copy-function* in external-format-in out external-format-out))))
226
227 (defun compare-files (path-in external-format-in path-out external-format-out)
228 "Copies the contents of the file (in the `test') denoted by the
229 relative pathname PATH-IN to the file (in a temporary directory)
230 denoted by the relative pathname PATH-OUT using flexi streams -
231 STREAM-IN is read with the external format EXTERNAL-FORMAT-IN and
232 STREAM-OUT is written with EXTERNAL-FORMAT-OUT. The resulting
233 file is compared with an existing file in the `test' directory to
234 check if the outcome is as expected. Uses various variants of
235 the :DIRECTION keyword when opening the files."
236 (let ((full-path-in (merge-pathnames path-in *this-file*))
237 (full-path-out (ensure-directories-exist
238 (merge-pathnames path-out *tmp-dir*)))
239 (full-path-orig (merge-pathnames path-out *this-file*)))
240 (dolist (direction-out '(:output :io))
241 (dolist (direction-in '(:input :io))
242 (format *error-output* "Test \(using ~A) ~S ~S [~A]~% --> ~S [~A].~%"
243 *copy-function* path-in
244 (flex::normalize-external-format external-format-in) direction-in
245 (flex::normalize-external-format external-format-out) direction-out)
246 (copy-file full-path-in external-format-in
247 full-path-out external-format-out
248 direction-out direction-in)
249 (cond ((file-equal full-path-out full-path-orig)
250 (incf *test-success-counter*))
251 (t (format *error-output* " Test failed!!!~%")))
252 (terpri *error-output*)
253 #+:lispworks
254 (format *error-output* "LW-Test \(using ~A) ~S ~S [~A]~% --> ~S [~A].~%"
255 *copy-function* path-in
256 (flex::normalize-external-format external-format-in) direction-in
257 (flex::normalize-external-format external-format-out) direction-out)
258 #+:lispworks
259 (copy-file-lw full-path-in external-format-in
260 full-path-out external-format-out
261 direction-out direction-in)
262 #+:lispworks
263 (cond ((file-equal full-path-out full-path-orig)
264 (incf *test-success-counter*))
265 (t (format *error-output* " Test failed!!!~%")))
266 #+:lispworks
267 (terpri *error-output*)))))
268
269 (defun file-as-octet-vector (pathspec)
270 "Returns the contents of the file denoted by PATHSPEC as a vector of
271 octets."
272 (with-open-file (in pathspec :element-type 'octet)
273 (let ((vector (make-array (file-length in) :element-type 'octet)))
274 (read-sequence vector in)
275 vector)))
276
277 (defun file-as-string (pathspec external-format)
278 "Reads the contents of the file denoted by PATHSPEC using the
279 external format EXTERNAL-FORMAT and returns the result as a string."
280 (with-open-file (in pathspec :element-type 'octet)
281 (let* ((number-of-octets (file-length in))
282 (in (make-flexi-stream in :external-format external-format))
283 (string (make-array number-of-octets
284 :element-type #+:lispworks 'lw:simple-char
285 #-:lispworks 'character
286 :fill-pointer t)))
287 (setf (fill-pointer string) (read-sequence string in))
288 string)))
289
290 (defun old-string-to-octets (string &key
291 (external-format (make-external-format :latin1))
292 (start 0) end)
293 "The old version of STRING-TO-OCTETS. We can use it to test
294 in-memory streams."
295 (declare (optimize speed))
296 (with-output-to-sequence (out)
297 (let ((flexi (make-flexi-stream out :external-format external-format)))
298 (write-string string flexi :start start :end end))))
299
300 (defun old-octets-to-string (vector &key
301 (external-format (make-external-format :latin1))
302 (start 0) (end (length vector)))
303 "The old version of OCTETS-TO-STRING. We can use it to test
304 in-memory streams."
305 (declare (optimize speed))
306 (with-input-from-sequence (in vector :start start :end end)
307 (let ((flexi (make-flexi-stream in :external-format external-format))
308 (result (make-array (- end start)
309 :element-type #+:lispworks 'lw:simple-char
310 #-:lispworks 'character
311 :fill-pointer t)))
312 (setf (fill-pointer result)
313 (read-sequence result flexi))
314 result)))
315
316 (defun string-test (pathspec external-format)
317 "Tests whether conversion from strings to octets and vice versa
318 using the external format EXTERNAL-FORMAT works as expected, using the
319 contents of the file denoted by PATHSPEC as test data and assuming
320 that the stream conversion functions work.
321
322 Also tests with the old versions of the conversion functions in order
323 to test in-memory streams."
324 (let* ((full-path (merge-pathnames pathspec *this-file*))
325 (octets-vector (file-as-octet-vector full-path))
326 (octets-list (coerce octets-vector 'list))
327 (string (file-as-string full-path external-format)))
328 (with-test ((format nil "String tests with format ~S."
329 (flex::normalize-external-format external-format)))
330 (check (string= (octets-to-string octets-vector :external-format external-format) string))
331 (check (string= (octets-to-string octets-list :external-format external-format) string))
332 (check (equalp (string-to-octets string :external-format external-format) octets-vector))
333 (check (string= (old-octets-to-string octets-vector :external-format external-format) string))
334 (check (string= (old-octets-to-string octets-list :external-format external-format) string))
335 (check (equalp (old-string-to-octets string :external-format external-format) octets-vector)))))
336
337 (defun sequence-equal (seq1 seq2)
338 "Whether the two sequences have the same elements."
339 (and (= (length seq1) (length seq2))
340 (loop for i below (length seq1)
341 always (eql (elt seq1 i) (elt seq2 i)))))
342
343 (defun sequence-test (pathspec external-format)
344 "Several tests to confirm that READ-SEQUENCE and WRITE-SEQUENCE
345 behave as expected."
346 (with-test ((format nil "Sequence tests with format ~S and file ~A."
347 (flex::normalize-external-format external-format) pathspec))
348 (let* ((full-path (merge-pathnames pathspec *this-file*))
349 (file-string (file-as-string full-path external-format))
350 (string-length (length file-string))
351 (octets (file-as-octet-vector full-path))
352 (octet-length (length octets)))
353 (when (external-format-equal external-format (make-external-format :utf8))
354 #-:openmcl
355 ;; FLEXI-STREAMS puts integers into the list, but OpenMCL
356 ;; thinks they are characters...
357 (with-open-file (in full-path :element-type 'octet)
358 (let* ((in (make-flexi-stream in :external-format external-format))
359 (list (make-list octet-length)))
360 (setf (flexi-stream-element-type in) 'octet)
361 #-:clisp
362 (read-sequence list in)
363 #+:clisp
364 (ext:read-byte-sequence list in)
365 (check (sequence-equal list octets))))
366 (with-open-file (in full-path :element-type 'octet)
367 (let* ((in (make-flexi-stream in :external-format external-format))
368 (third (floor octet-length 3))
369 (half (floor octet-length 2))
370 (vector (make-array half :element-type 'octet)))
371 (check (sequence-equal (loop repeat third
372 collect (read-byte in))
373 (subseq octets 0 third)))
374 (read-sequence vector in)
375 (check (sequence-equal vector (subseq octets third (+ third half)))))))
376 (with-open-file (in full-path :element-type 'octet)
377 (let* ((in (make-flexi-stream in :external-format external-format))
378 (string (make-string (- string-length 10) :element-type 'flex::char*)))
379 (setf (flexi-stream-element-type in) 'octet)
380 (check (sequence-equal (loop repeat 10
381 collect (read-char in))
382 (subseq file-string 0 10)))
383 (read-sequence string in)
384 (check (sequence-equal string (subseq file-string 10)))))
385 (with-open-file (in full-path :element-type 'octet)
386 (let* ((in (make-flexi-stream in :external-format external-format))
387 (list (make-list (- string-length 100))))
388 (check (sequence-equal (loop repeat 50
389 collect (read-char in))
390 (subseq file-string 0 50)))
391 #-:clisp
392 (read-sequence list in)
393 #+:clisp
394 (ext:read-char-sequence list in)
395 (check (sequence-equal list (subseq file-string 50 (- string-length 50))))
396 (check (sequence-equal (loop repeat 50
397 collect (read-char in))
398 (subseq file-string (- string-length 50))))))
399 (with-open-file (in full-path :element-type 'octet)
400 (let* ((in (make-flexi-stream in :external-format external-format))
401 (array (make-array (- string-length 50))))
402 (check (sequence-equal (loop repeat 25
403 collect (read-char in))
404 (subseq file-string 0 25)))
405 #-:clisp
406 (read-sequence array in)
407 #+:clisp
408 (ext:read-char-sequence array in)
409 (check (sequence-equal array (subseq file-string 25 (- string-length 25))))
410 (check (sequence-equal (loop repeat 25
411 collect (read-char in))
412 (subseq file-string (- string-length 25))))))
413 (let ((path-out (ensure-directories-exist (merge-pathnames pathspec *tmp-dir*))))
414 (with-open-file (out path-out
415 :direction :output
416 :if-exists :supersede
417 :element-type 'octet)
418 (let ((out (make-flexi-stream out :external-format external-format)))
419 (write-sequence octets out)))
420 (check (file-equal full-path path-out))
421 (with-open-file (out path-out
422 :direction :output
423 :if-exists :supersede
424 :element-type 'octet)
425 (let ((out (make-flexi-stream out :external-format external-format)))
426 (write-sequence file-string out)))
427 (check (file-equal full-path path-out))
428 (with-open-file (out path-out
429 :direction :output
430 :if-exists :supersede
431 :element-type 'octet)
432 (let ((out (make-flexi-stream out :external-format external-format)))
433 (write-sequence file-string out :end 100)
434 (write-sequence octets out
435 :start (length (string-to-octets file-string
436 :external-format external-format
437 :end 100)))))
438 (check (file-equal full-path path-out))))))
439
440 (defmacro using-values ((&rest values) &body body)
441 "Executes BODY and feeds an element from VALUES to the USE-VALUE
442 restart each time a EXTERNAL-FORMAT-ENCODING-ERROR is signalled.
443 Signals an error when there are more or less
444 EXTERNAL-FORMAT-ENCODING-ERRORs than there are elements in VALUES."
445 (flex::with-unique-names (value-stack condition-counter)
446 `(let ((,value-stack ',values)
447 (,condition-counter 0))
448 (handler-bind ((external-format-encoding-error
449 #'(lambda (c)
450 (declare (ignore c))
451 (unless ,value-stack
452 (error "Too many encoding errors signalled, expected only ~A."
453 ,(length values)))
454 (incf ,condition-counter)
455 (use-value (pop ,value-stack)))))
456 (prog1 (progn ,@body)
457 (when ,value-stack
458 (error "~A encoding errors signalled, but ~A were expected."
459 ,condition-counter ,(length values))))))))
460
461 (defun read-flexi-line (sequence external-format)
462 "Creates and returns a string from the octet sequence SEQUENCE using
463 the external format EXTERNAL-FORMAT."
464 (with-input-from-sequence (in sequence)
465 (setq in (make-flexi-stream in :external-format external-format))
466 (read-line in)))
467
468 (defun read-flexi-line* (sequence external-format)
469 "Like READ-FLEXI-LINE but uses OCTETS-TO-STRING internally."
470 (octets-to-string sequence :external-format external-format))
471
472 (defun error-handling-test ()
473 "Tests several possible errors and how they are handled."
474 (with-test ("Illegal values.")
475 (macrolet ((want-encoding-error (input format)
476 `(with-expected-error (external-format-encoding-error)
477 (read-flexi-line* ,input ,format))))
478 ;; "overlong"
479 (want-encoding-error #(#b11000000) :utf-8)
480 (want-encoding-error #(#b11000001) :utf-8)
481 ;; examples of invalid lead octets
482 (want-encoding-error #(#b11111000) :utf-8)
483 (want-encoding-error #(#b11111001) :utf-8)
484 (want-encoding-error #(#b11111100) :utf-8)
485 (want-encoding-error #(#b11111101) :utf-8)
486 (want-encoding-error #(#b11111110) :utf-8)
487 (want-encoding-error #(#b11111111) :utf-8)
488 ;; illegal code points
489 (want-encoding-error #(#x00 #x00 #x11 #x00) :utf-32le)
490 (want-encoding-error #(#x00 #xd8) :utf-16le)
491 (want-encoding-error #(#xff #xdf) :utf-16le)))
492 (with-test ("Illegal lengths.")
493 (macrolet ((want-encoding-error (input format)
494 `(with-expected-error (external-format-encoding-error)
495 (read-flexi-line* ,input ,format))))
496 ;; UTF-8 sequences which are too short
497 (want-encoding-error #(#xe4 #xf6 #xfc) :utf8)
498 (want-encoding-error #(#xc0) :utf8)
499 (want-encoding-error #(#xe0 #xff) :utf8)
500 (want-encoding-error #(#xf0 #xff #xff) :utf8)
501 ;; UTF-16 wants an even number of octets
502 (want-encoding-error #(#x01) :utf-16le)
503 (want-encoding-error #(#x01 #x01 #x01) :utf-16le)
504 (want-encoding-error #(#x01) :utf-16be)
505 (want-encoding-error #(#x01 #x01 #x01) :utf-16be)
506 ;; another word should follow but it doesn't
507 (want-encoding-error #(#x01 #xd8) :utf-16le)
508 (want-encoding-error #(#xd8 #x01) :utf-16be)
509 ;; UTF-32 always wants four octets
510 (want-encoding-error #(#x01) :utf-32le)
511 (want-encoding-error #(#x01 #x01) :utf-32le)
512 (want-encoding-error #(#x01 #x01 #x01) :utf-32le)
513 (want-encoding-error #(#x01 #x01 #x01 #x01 #x01) :utf-32le)
514 (want-encoding-error #(#x01) :utf-32be)
515 (want-encoding-error #(#x01 #x01) :utf-32be)
516 (want-encoding-error #(#x01 #x01 #x01) :utf-32be)
517 (want-encoding-error #(#x01 #x01 #x01 #x01 #x01) :utf-32be)))
518 (with-test ("Errors while decoding and substitution of characters.")
519 ;; handling of EOF in the middle of CRLF
520 (check (string= #.(string #\Return)
521 (read-flexi-line `(,(char-code #\Return)) '(:ascii :eol-style :crlf))))
522 (let ((*substitution-char* #\?))
523 ;; :ASCII doesn't have characters with char codes > 127
524 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 128 200) :ascii)))
525 (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii)))
526 ;; :WINDOWS-1253 doesn't have a characters with codes 170 and 210
527 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253)))
528 (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 170 210) :windows-1253)))
529 ;; not a valid UTF-8 sequence
530 (check (string= "??" (read-flexi-line '(#xe4 #xf6 #xfc) :utf8))))
531 (let ((*substitution-char* nil))
532 ;; :ASCII doesn't have characters with char codes > 127
533 (check (string= "abc" (using-values (#\b #\c)
534 (read-flexi-line `(,(char-code #\a) 128 200) :ascii))))
535 (check (string= "abc" (using-values (#\b #\c)
536 (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii))))
537 ;; :WINDOWS-1253 encoding doesn't have a characters with codes 170 and 210
538 (check (string= "axy" (using-values (#\x #\y)
539 (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253))))
540 (check (string= "axy" (using-values (#\x #\y)
541 (read-flexi-line* `#(,(char-code #\a) 170 210) :windows-1253))))
542 ;; not a valid UTF-8 sequence
543 (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line '(#xe4 #xf6 #xfc) :utf8))))
544 ;; UTF-8 can't start neither with #b11111110 nor with #b11111111
545 (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line '(#b11111110 #b11111111) :utf8))))
546 ;; only one byte
547 (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16le))))
548 ;; two bytes, but value of resulting word suggests that another word follows
549 (check (string= "R" (using-values (#\R) (read-flexi-line '(#x01 #xd8) :utf-16le))))
550 ;; the second word must fit into the [#xdc00; #xdfff] interval, but it is #xdbff
551 (check (string= "T" (using-values (#\T) (read-flexi-line '(#x01 #xd8 #xff #xdb) :utf-16le))))
552 (check (string= "T" (using-values (#\T) (read-flexi-line* #(#x01 #xd8 #xff #xdb) :utf-16le))))
553 ;; the same as for little endian above, but using inverse order of bytes in words
554 (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16be))))
555 (check (string= "R" (using-values (#\R) (read-flexi-line '(#xd8 #x01) :utf-16be))))
556 (check (string= "T" (using-values (#\T) (read-flexi-line '(#xd8 #x01 #xdb #xff) :utf-16be))))
557 (check (string= "T" (using-values (#\T) (read-flexi-line* #(#xd8 #x01 #xdb #xff) :utf-16be))))
558 ;; the only case when errors are signalled for UTF-32 is at end
559 ;; of file in the middle of 4-byte sequence, both for big and
560 ;; little endian
561 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01) :utf-32le))))
562 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01) :utf-32le))))
563 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01 #x01) :utf-32le))))
564 (check (string= "aY" (using-values (#\Y)
565 (read-flexi-line `(,(char-code #\a) #x00 #x00 #x00 #x01) :utf-32le))))
566 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01) :utf-32be))))
567 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01) :utf-32be))))
568 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01 #x01) :utf-32be))))
569 (check (string= "aY" (using-values (#\Y)
570 (read-flexi-line `(#x00 #x00 #x00 ,(char-code #\a) #x01) :utf-32be)))))))
571
572 (defun unread-char-test ()
573 "Tests whether UNREAD-CHAR behaves as expected."
574 (with-test ("UNREAD-CHAR behaviour.")
575 (flet ((test-one-file (file-name external-format)
576 (with-open-file (in (merge-pathnames file-name *this-file*)
577 :element-type 'flex:octet)
578 (let ((in (make-flexi-stream in :external-format external-format)))
579 (loop repeat 300
580 for char = (read-char in)
581 do (unread-char char in)
582 (check (char= (read-char in) char)))))))
583 (loop for (file-name symbols) in *test-files*
584 do (loop for symbol in symbols
585 do (loop for (file-name . external-format) in (create-file-variants file-name symbol)
586 do (test-one-file file-name external-format)))))))
587
588 (defun run-tests ()
589 "Applies COMPARE-FILES to all test scenarios created with
590 CREATE-TEST-COMBINATIONS, runs other tests like handling of encoding
591 errors, shows simple statistics at the end."
592 (let* ((*test-success-counter* 0)
593 (compare-files-args-list (loop for (file-name symbols) in *test-files*
594 nconc (create-test-combinations file-name symbols)))
595 (no-tests (* 8 (length compare-files-args-list))))
596 #+:lispworks
597 (setq no-tests (* 2 no-tests))
598 (dolist (*copy-function* '(copy-stream copy-stream*))
599 (dolist (args compare-files-args-list)
600 (apply 'compare-files args)))
601 (let ((string-test-args-list (loop for (file-name symbols) in *test-files*
602 nconc (create-test-combinations file-name symbols t))))
603 (incf no-tests (length string-test-args-list))
604 (dolist (args string-test-args-list)
605 (apply 'string-test args)))
606 (let ((read-sequence-test-args-list (loop for (file-name symbols) in *test-files*
607 nconc (create-test-combinations file-name symbols t))))
608 (incf no-tests (length read-sequence-test-args-list))
609 (dolist (args read-sequence-test-args-list)
610 (apply 'sequence-test args)))
611 (incf no-tests 3)
612 (error-handling-test)
613 (incf no-tests)
614 (unread-char-test)
615 (format *error-output* "~%~%~:[~A of ~A tests failed..~;~*All ~A tests passed~].~%"
616 (= no-tests *test-success-counter*) (- no-tests *test-success-counter*) no-tests)))
617

  ViewVC Help
Powered by ViewVC 1.1.5