3rdparties/software/flexi-streams-20200427-git/test/test.lisp (41033 bytes)
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*- 2 ;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.39 2008/05/30 09:10:55 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-suite ((test-description &key show-progress-p) &body body) 33 "Defines a test suite. Three utilities are available inside of the 34 body of the macro: The function FAIL, and the macros CHECK and 35 WITH-EXPECTED-ERROR. FAIL, the lowest level utility, marks the test 36 defined by WITH-TEST-SUITE as failed. CHECK checks whether its argument is 37 true, otherwise it calls FAIL. If during evaluation of the specified 38 expression any condition is signalled, this is also considered a 39 failure. WITH-EXPECTED-ERROR executes its body and considers the test 40 a success if the specified error was signalled, otherwise it calls 41 FAIL. 42 43 WITH-TEST-SUITE prints a simple progress report if SHOW-PROGRESS-P is true." 44 (with-unique-names (successp testcount) 45 (with-rebinding (show-progress-p) 46 `(let ((,successp t) 47 (,testcount 1)) 48 (when (and ,show-progress-p (not (numberp ,show-progress-p))) 49 (setq ,show-progress-p 1)) 50 (flet ((fail (format-str &rest format-args) 51 (apply #'format t format-str format-args) 52 (setq ,successp nil)) 53 (maybe-show-progress () 54 (when (and ,show-progress-p (zerop (mod ,testcount ,show-progress-p))) 55 (format t ".") 56 (when (zerop (mod ,testcount (* 10 ,show-progress-p))) 57 (terpri)) 58 (force-output)) 59 (incf ,testcount))) 60 (macrolet ((check (expression) 61 `(progn 62 (maybe-show-progress) 63 (handler-case 64 (unless ,expression 65 (fail "~&Test ~S failed.~%" ',expression)) 66 (error (c) 67 (fail "~&Test ~S failed signalling error of type ~A: ~A.~%" 68 ',expression (type-of c) c))))) 69 (with-expected-error ((condition-type) &body body) 70 `(progn 71 (maybe-show-progress) 72 (handler-case (progn ,@body) 73 (,condition-type () t) 74 (:no-error (&rest args) 75 (declare (ignore args)) 76 (fail "~&Expected condition ~S not signalled.~%" 77 ',condition-type)))))) 78 (format t "~&Test suite: ~S~%" ,test-description) 79 ,@body)) 80 ,successp)))) 81 82 ;; LW can't indent this correctly because it's in a MACROLET 83 #+:lispworks 84 (editor:setup-indent "with-expected-error" 1 2 4) 85 86 (defconstant +buffer-size+ 8192 87 "Size of buffers for COPY-STREAM* below.") 88 89 (defvar *copy-function* nil 90 "Which function to use when copying from one stream to the other - 91 see for example COPY-FILE below.") 92 93 (defvar *this-file* (load-time-value 94 (or #.*compile-file-pathname* *load-pathname*)) 95 "The pathname of the file \(`test.lisp') where this variable was 96 defined.") 97 98 #+:lispworks 99 (defun get-env-variable-as-directory (name) 100 (lw:when-let (string (lw:environment-variable name)) 101 (when (plusp (length string)) 102 (cond ((find (char string (1- (length string))) "\\/" :test #'char=) string) 103 (t (lw:string-append string "/")))))) 104 105 (defvar *tmp-dir* 106 (load-time-value 107 (merge-pathnames "odd-streams-test/" 108 #+:allegro (system:temporary-directory) 109 #+:lispworks (pathname (or (get-env-variable-as-directory "TEMP") 110 (get-env-variable-as-directory "TMP") 111 #+:win32 "C:/" 112 #-:win32 "/tmp/")) 113 #-(or :allegro :lispworks) #p"/tmp/")) 114 "The pathname of a temporary directory used for testing.") 115 116 (defvar *test-files* 117 '(("kafka" (:utf8 :latin1 :cp1252)) 118 ("tilton" (:utf8 :ascii)) 119 ("hebrew" (:utf8 :latin8)) 120 ("russian" (:utf8 :koi8r)) 121 ("unicode_demo" (:utf8 :ucs2 :ucs4))) 122 "A list of test files where each entry consists of the name 123 prefix and a list of encodings.") 124 125 (defun create-file-variants (file-name symbol) 126 "For a name suffix FILE-NAME and a symbol SYMBOL denoting an 127 encoding returns a list of pairs where the car is a full file 128 name and the cdr is the corresponding external format. This list 129 contains all possible variants w.r.t. to line-end conversion and 130 endianness." 131 (let ((args (ecase symbol 132 (:ascii '(:ascii)) 133 (:latin1 '(:latin-1)) 134 (:latin8 '(:hebrew)) 135 (:cp1252 '(:code-page :id 1252)) 136 (:koi8r '(:koi8-r)) 137 (:utf8 '(:utf-8)) 138 (:ucs2 '(:utf-16)) 139 (:ucs4 '(:utf-32)))) 140 (endianp (member symbol '(:ucs2 :ucs4)))) 141 (loop for little-endian in (if endianp '(t nil) '(t)) 142 for endian-suffix in (if endianp '("_le" "_be") '("")) 143 nconc (loop for eol-style in '(:lf :cr :crlf) 144 collect (cons (format nil "~A_~(~A~)_~(~A~)~A.txt" 145 file-name symbol eol-style endian-suffix) 146 (apply #'make-external-format 147 (append args `(:eol-style ,eol-style 148 :little-endian ,little-endian)))))))) 149 150 (defun create-test-combinations (file-name symbols &optional simplep) 151 "For a name suffix FILE-NAME and a list of symbols SYMBOLS denoting 152 different encodings of the corresponding file returns a list of lists 153 which can be used as arglists by COMPARE-FILES. If SIMPLEP is true, a 154 list which can be used for the string and sequence tests below is 155 returned." 156 (let ((file-variants (loop for symbol in symbols 157 nconc (create-file-variants file-name symbol)))) 158 (loop for (name-in . external-format-in) in file-variants 159 when simplep 160 collect (list name-in external-format-in) 161 else 162 nconc (loop for (name-out . external-format-out) in file-variants 163 collect (list name-in external-format-in name-out external-format-out))))) 164 165 (defun file-equal (file1 file2) 166 "Returns a true value iff FILE1 and FILE2 have the same 167 contents \(viewed as binary files)." 168 (with-open-file (stream1 file1 :element-type 'octet) 169 (with-open-file (stream2 file2 :element-type 'octet) 170 (and (= (file-length stream1) (file-length stream2)) 171 (loop for byte1 = (read-byte stream1 nil nil) 172 for byte2 = (read-byte stream2 nil nil) 173 while (and byte1 byte2) 174 always (= byte1 byte2)))))) 175 176 (defun copy-stream (stream-in external-format-in stream-out external-format-out) 177 "Copies the contents of the binary stream STREAM-IN to the 178 binary stream STREAM-OUT using flexi streams - STREAM-IN is read 179 with the external format EXTERNAL-FORMAT-IN and STREAM-OUT is 180 written with EXTERNAL-FORMAT-OUT." 181 (let ((in (make-flexi-stream stream-in :external-format external-format-in)) 182 (out (make-flexi-stream stream-out :external-format external-format-out))) 183 (loop for line = (read-line in nil nil) 184 while line 185 do (write-line line out)))) 186 187 (defun copy-stream* (stream-in external-format-in stream-out external-format-out) 188 "Like COPY-STREAM, but uses READ-SEQUENCE and WRITE-SEQUENCE instead 189 of READ-LINE and WRITE-LINE." 190 (let ((in (make-flexi-stream stream-in :external-format external-format-in)) 191 (out (make-flexi-stream stream-out :external-format external-format-out)) 192 (buffer (make-array +buffer-size+ :element-type 'char*))) 193 (loop 194 (let ((position (read-sequence buffer in))) 195 (when (zerop position) (return)) 196 (write-sequence buffer out :end position))))) 197 198 (defun copy-file (path-in external-format-in path-out external-format-out direction-out direction-in) 199 "Copies the contents of the file denoted by the pathname 200 PATH-IN to the file denoted by the pathname PATH-OUT using flexi 201 streams - STREAM-IN is read with the external format 202 EXTERNAL-FORMAT-IN and STREAM-OUT is written with 203 EXTERNAL-FORMAT-OUT. The input file is opened with 204 the :DIRECTION keyword argument DIRECTION-IN, the output file is 205 opened with the :DIRECTION keyword argument DIRECTION-OUT." 206 (with-open-file (in path-in 207 :element-type 'octet 208 :direction direction-in 209 :if-does-not-exist :error 210 :if-exists :overwrite) 211 (with-open-file (out path-out 212 :element-type 'octet 213 :direction direction-out 214 :if-does-not-exist :create 215 :if-exists :supersede) 216 (funcall *copy-function* in external-format-in out external-format-out)))) 217 218 #+:lispworks 219 (defun copy-file-lw (path-in external-format-in path-out external-format-out direction-out direction-in) 220 "Same as COPY-FILE, but uses character streams instead of 221 binary streams. Only used to test LispWorks-specific behaviour." 222 (with-open-file (in path-in 223 :external-format '(:latin-1 :eol-style :lf) 224 :element-type 'base-char 225 :direction direction-in 226 :if-does-not-exist :error 227 :if-exists :overwrite) 228 (with-open-file (out path-out 229 :external-format '(:latin-1 :eol-style :lf) 230 :element-type 'base-char 231 :direction direction-out 232 :direction :output 233 :if-does-not-exist :create 234 :if-exists :supersede) 235 (funcall *copy-function* in external-format-in out external-format-out)))) 236 237 (defun compare-files (&key verbose) 238 "Each test in this suite copies the contents of one file \(in the 239 `test' directory) to another file \(in a temporary directory) using 240 flexi streams with different external formats. The resulting file is 241 compared with an existing file in the `test' directory to check if the 242 outcome is as expected. Uses various variants of the :DIRECTION 243 keyword when opening the files. 244 245 Returns a true value iff all tests succeeded. Prints information 246 about each individual comparison if VERBOSE is true." 247 (with-test-suite ("Reading/writing files" :show-progress-p (not verbose)) 248 (flet ((one-comparison (path-in external-format-in path-out external-format-out verbose) 249 (when verbose 250 (format t "~&File ~S, using copy function ~S" (file-namestring path-in) *copy-function*) 251 (format t "~& and external formats ~S --> ~S" 252 (normalize-external-format external-format-in) 253 (normalize-external-format external-format-out))) 254 (let ((full-path-in (merge-pathnames path-in *this-file*)) 255 (full-path-out (ensure-directories-exist 256 (merge-pathnames path-out *tmp-dir*))) 257 (full-path-orig (merge-pathnames path-out *this-file*))) 258 (dolist (direction-out '(:output :io)) 259 (dolist (direction-in '(:input :io)) 260 (when verbose 261 (format t "~&...directions ~S --> ~S" direction-in direction-out)) 262 (copy-file full-path-in external-format-in 263 full-path-out external-format-out 264 direction-out direction-in) 265 (check (file-equal full-path-out full-path-orig)) 266 #+:lispworks 267 (progn 268 (when verbose 269 (format t "~&...directions ~S --> ~S \(LispWorks)" direction-in direction-out)) 270 (copy-file-lw full-path-in external-format-in 271 full-path-out external-format-out 272 direction-out direction-in) 273 (check (file-equal full-path-out full-path-orig)))))))) 274 (loop with compare-files-args-list = (loop for (file-name symbols) in *test-files* 275 nconc (create-test-combinations file-name symbols)) 276 for *copy-function* in '(copy-stream copy-stream*) 277 do (loop for (path-in external-format-in path-out external-format-out) in compare-files-args-list 278 do (one-comparison path-in external-format-in path-out external-format-out verbose)))))) 279 280 (defun file-as-octet-vector (pathspec) 281 "Returns the contents of the file denoted by PATHSPEC as a vector of 282 octets." 283 (with-open-file (in pathspec :element-type 'octet) 284 (let ((vector (make-array (file-length in) :element-type 'octet))) 285 (read-sequence vector in) 286 vector))) 287 288 (defun file-as-string (pathspec external-format) 289 "Reads the contents of the file denoted by PATHSPEC using the 290 external format EXTERNAL-FORMAT and returns the result as a string." 291 (with-open-file (in pathspec :element-type 'octet) 292 (let* ((number-of-octets (file-length in)) 293 (in (make-flexi-stream in :external-format external-format)) 294 (string (make-array number-of-octets 295 :element-type #+:lispworks 'lw:simple-char 296 #-:lispworks 'character 297 :fill-pointer t))) 298 (setf (fill-pointer string) (read-sequence string in)) 299 string))) 300 301 (defun old-string-to-octets (string &key 302 (external-format (make-external-format :latin1)) 303 (start 0) end) 304 "The old version of STRING-TO-OCTETS. We can use it to test 305 in-memory streams." 306 (declare (optimize speed)) 307 (with-output-to-sequence (out) 308 (let ((flexi (make-flexi-stream out :external-format external-format))) 309 (write-string string flexi :start start :end end)))) 310 311 (defun old-octets-to-string (vector &key 312 (external-format (make-external-format :latin1)) 313 (start 0) (end (length vector))) 314 "The old version of OCTETS-TO-STRING. We can use it to test 315 in-memory streams." 316 (declare (optimize speed)) 317 (with-input-from-sequence (in vector :start start :end end) 318 (let ((flexi (make-flexi-stream in :external-format external-format)) 319 (result (make-array (- end start) 320 :element-type #+:lispworks 'lw:simple-char 321 #-:lispworks 'character 322 :fill-pointer t))) 323 (setf (fill-pointer result) 324 (read-sequence result flexi)) 325 result))) 326 327 (defun string-tests (&key verbose) 328 "Tests whether conversion from strings to octets and vice versa 329 works as expected. Also tests with the old versions of the conversion 330 functions in order to test in-memory streams." 331 (with-test-suite ("String tests" :show-progress-p (and (not verbose) 10)) 332 (flet ((one-string-test (pathspec external-format verbose) 333 (when verbose 334 (format t "~&With external format ~S:" (normalize-external-format external-format))) 335 (let* ((full-path (merge-pathnames pathspec *this-file*)) 336 (octets-vector (file-as-octet-vector full-path)) 337 (octets-list (coerce octets-vector 'list)) 338 (string (file-as-string full-path external-format))) 339 (when verbose 340 (format t "~&...testing OCTETS-TO-STRING")) 341 (check (string= (octets-to-string octets-vector :external-format external-format) string)) 342 (check (string= (octets-to-string octets-list :external-format external-format) string)) 343 (when verbose 344 (format t "~&...testing STRING-TO-OCTETS")) 345 (check (equalp (string-to-octets string :external-format external-format) octets-vector)) 346 (when verbose 347 (format t "~&...testing in-memory streams")) 348 (check (string= (old-octets-to-string octets-vector :external-format external-format) string)) 349 (check (string= (old-octets-to-string octets-list :external-format external-format) string)) 350 (check (equalp (old-string-to-octets string :external-format external-format) octets-vector))))) 351 (loop with simple-test-args-list = (loop for (file-name symbols) in *test-files* 352 nconc (create-test-combinations file-name symbols t)) 353 for (pathspec external-format) in simple-test-args-list 354 do (one-string-test pathspec external-format verbose))))) 355 356 357 (defun sequence-equal (seq1 seq2) 358 "Whether the two sequences have the same elements." 359 (and (= (length seq1) (length seq2)) 360 (loop for i below (length seq1) 361 always (eql (elt seq1 i) (elt seq2 i))))) 362 363 (defun sequence-tests (&key verbose) 364 "Several tests to confirm that READ-SEQUENCE and WRITE-SEQUENCE 365 behave as expected." 366 (with-test-suite ("Sequence tests" :show-progress-p (and (not verbose) 10)) 367 (flet ((one-sequence-test (pathspec external-format verbose) 368 (when verbose 369 (format t "~&With external format ~S:" (normalize-external-format external-format))) 370 (let* ((full-path (merge-pathnames pathspec *this-file*)) 371 (file-string (file-as-string full-path external-format)) 372 (string-length (length file-string)) 373 (octets (file-as-octet-vector full-path)) 374 (octet-length (length octets))) 375 (when (external-format-equal external-format (make-external-format :utf8)) 376 (when verbose 377 (format t "~&...reading octets")) 378 (with-open-file (in full-path :element-type 'octet) 379 (let* ((in (make-flexi-stream in :external-format external-format)) 380 (list (make-list octet-length))) 381 (setf (flexi-stream-element-type in) 'octet) 382 (let ((position #-:clisp 383 (read-sequence list in) 384 #+:clisp 385 (ext:read-byte-sequence list in))) 386 (check (= position 387 (flexi-stream-position in)))) 388 (check (sequence-equal list octets)))) 389 (with-open-file (in full-path :element-type 'octet) 390 (let* ((in (make-flexi-stream in :external-format external-format)) 391 (third (floor octet-length 3)) 392 (half (floor octet-length 2)) 393 (vector (make-array half :element-type 'octet))) 394 (check (sequence-equal (loop repeat third 395 collect (read-byte in)) 396 (subseq octets 0 third))) 397 (read-sequence vector in) 398 (check (sequence-equal vector (subseq octets third (+ third half))))))) 399 (when verbose 400 (format t "~&...reading characters")) 401 (with-open-file (in full-path :element-type 'octet) 402 (let* ((in (make-flexi-stream in :external-format external-format)) 403 (string (make-string (- string-length 10) :element-type 'char*))) 404 (setf (flexi-stream-element-type in) 'octet) 405 (check (sequence-equal (loop repeat 10 406 collect (read-char in)) 407 (subseq file-string 0 10))) 408 (read-sequence string in) 409 (check (sequence-equal string (subseq file-string 10))))) 410 (with-open-file (in full-path :element-type 'octet) 411 (let* ((in (make-flexi-stream in :external-format external-format)) 412 (list (make-list (- string-length 100)))) 413 (check (sequence-equal (loop repeat 50 414 collect (read-char in)) 415 (subseq file-string 0 50))) 416 #-:clisp 417 (read-sequence list in) 418 #+:clisp 419 (ext:read-char-sequence list in) 420 (check (sequence-equal list (subseq file-string 50 (- string-length 50)))) 421 (check (sequence-equal (loop repeat 50 422 collect (read-char in)) 423 (subseq file-string (- string-length 50)))))) 424 (with-open-file (in full-path :element-type 'octet) 425 (let* ((in (make-flexi-stream in :external-format external-format)) 426 (array (make-array (- string-length 50)))) 427 (check (sequence-equal (loop repeat 25 428 collect (read-char in)) 429 (subseq file-string 0 25))) 430 #-:clisp 431 (read-sequence array in) 432 #+:clisp 433 (ext:read-char-sequence array in) 434 (check (sequence-equal array (subseq file-string 25 (- string-length 25)))) 435 (check (sequence-equal (loop repeat 25 436 collect (read-char in)) 437 (subseq file-string (- string-length 25)))))) 438 (let ((path-out (ensure-directories-exist (merge-pathnames pathspec *tmp-dir*)))) 439 (when verbose 440 (format t "~&...writing sequences")) 441 (with-open-file (out path-out 442 :direction :output 443 :if-exists :supersede 444 :element-type 'octet) 445 (let ((out (make-flexi-stream out :external-format external-format))) 446 (write-sequence octets out))) 447 (check (file-equal full-path path-out)) 448 (with-open-file (out path-out 449 :direction :output 450 :if-exists :supersede 451 :element-type 'octet) 452 (let ((out (make-flexi-stream out :external-format external-format))) 453 (write-sequence file-string out))) 454 (check (file-equal full-path path-out)) 455 (with-open-file (out path-out 456 :direction :output 457 :if-exists :supersede 458 :element-type 'octet) 459 (let ((out (make-flexi-stream out :external-format external-format))) 460 (write-sequence file-string out :end 100) 461 (write-sequence octets out 462 :start (length (string-to-octets file-string 463 :external-format external-format 464 :end 100))))) 465 (check (file-equal full-path path-out)))))) 466 467 (loop with simple-test-args-list = (loop for (file-name symbols) in *test-files* 468 nconc (create-test-combinations file-name symbols t)) 469 for (pathspec external-format) in simple-test-args-list 470 do (one-sequence-test pathspec external-format verbose))))) 471 472 (defmacro using-values ((&rest values) &body body) 473 "Executes BODY and feeds an element from VALUES to the USE-VALUE 474 restart each time a EXTERNAL-FORMAT-ENCODING-ERROR is signalled. 475 Signals an error when there are more or less 476 EXTERNAL-FORMAT-ENCODING-ERRORs than there are elements in VALUES." 477 (with-unique-names (value-stack condition-counter) 478 `(let ((,value-stack ',values) 479 (,condition-counter 0)) 480 (handler-bind ((external-format-encoding-error 481 #'(lambda (c) 482 (declare (ignore c)) 483 (unless ,value-stack 484 (error "Too many encoding errors signalled, expected only ~A." 485 ,(length values))) 486 (incf ,condition-counter) 487 (use-value (pop ,value-stack))))) 488 (prog1 (progn ,@body) 489 (when ,value-stack 490 (error "~A encoding errors signalled, but ~A were expected." 491 ,condition-counter ,(length values)))))))) 492 493 (defun accept-overlong (octets code-point) 494 "Converts the `overlong' UTF-8 sequence OCTETS to using 495 OCTETS-TO-STRINGS, accepts the expected error with the corresponding 496 restart and checks that the result is CODE-POINT." 497 (handler-bind ((external-format-encoding-error 498 (lambda (c) 499 (declare (ignore c)) 500 (invoke-restart 'accept-overlong-sequence)))) 501 (string= (octets-to-string octets :external-format :utf-8) 502 (string (code-char code-point))))) 503 504 (defun read-flexi-line (sequence external-format) 505 "Creates and returns a string from the octet sequence SEQUENCE using 506 the external format EXTERNAL-FORMAT." 507 (with-input-from-sequence (in sequence) 508 (setq in (make-flexi-stream in :external-format external-format)) 509 (read-line in))) 510 511 (defun read-flexi-line* (sequence external-format) 512 "Like READ-FLEXI-LINE but uses OCTETS-TO-STRING internally." 513 (octets-to-string sequence :external-format external-format)) 514 515 (defun error-handling-tests (&key verbose) 516 "Tests several possible errors and how they are handled." 517 (with-test-suite ("Testing error handling" :show-progress-p (not verbose)) 518 (macrolet ((want-encoding-error (input format) 519 `(with-expected-error (external-format-encoding-error) 520 (read-flexi-line* ,input ,format)))) 521 (when verbose 522 (format t "~&\"Overlong\" UTF-8 sequences")) 523 (want-encoding-error #(#b11000000 #b10000000) :utf-8) 524 (want-encoding-error #(#b11000001 #b10000000) :utf-8) 525 (want-encoding-error #(#b11100000 #b10011111 #b10000000) :utf-8) 526 (want-encoding-error #(#b11110000 #b10001111 #b10000000 #b10000000) :utf-8) 527 (check (accept-overlong #(#b11000000 #b10000000) #b00000000)) 528 (check (accept-overlong #(#b11000001 #b10000000) #b01000000)) 529 (check (accept-overlong #(#b11100000 #b10011111 #b10000000) #b011111000000)) 530 (check (accept-overlong #(#b11110000 #b10001111 #b10000000 #b10000000) 531 #b1111000000000000)) 532 (when verbose 533 (format t "~&Invalid lead octets in UTF-8")) 534 (want-encoding-error #(#b11111000) :utf-8) 535 (want-encoding-error #(#b11111001) :utf-8) 536 (want-encoding-error #(#b11111100) :utf-8) 537 (want-encoding-error #(#b11111101) :utf-8) 538 (want-encoding-error #(#b11111110) :utf-8) 539 (want-encoding-error #(#b11111111) :utf-8) 540 (when verbose 541 (format t "~&Illegal code points")) 542 (want-encoding-error #(#x00 #x00 #x11 #x00) :utf-32le) 543 (want-encoding-error #(#x00 #xd8) :utf-16le) 544 (want-encoding-error #(#xff #xdf) :utf-16le)) 545 (macrolet ((want-encoding-error (input format) 546 `(with-expected-error (external-format-encoding-error) 547 (read-flexi-line* ,input ,format)))) 548 (when verbose 549 (format t "~&UTF-8 sequences which are too short")) 550 (want-encoding-error #(#xe4 #xf6 #xfc) :utf8) 551 (want-encoding-error #(#xc0) :utf8) 552 (want-encoding-error #(#xe0 #xff) :utf8) 553 (want-encoding-error #(#xf0 #xff #xff) :utf8) 554 (when verbose 555 (format t "~&UTF-16 sequences with an odd number of octets")) 556 (want-encoding-error #(#x01) :utf-16le) 557 (want-encoding-error #(#x01 #x01 #x01) :utf-16le) 558 (want-encoding-error #(#x01) :utf-16be) 559 (want-encoding-error #(#x01 #x01 #x01) :utf-16be) 560 (when verbose 561 (format t "~&Missing words in UTF-16")) 562 (want-encoding-error #(#x01 #xd8) :utf-16le) 563 (want-encoding-error #(#xd8 #x01) :utf-16be) 564 (when verbose 565 (format t "~&Missing octets in UTF-32")) 566 (want-encoding-error #(#x01) :utf-32le) 567 (want-encoding-error #(#x01 #x01) :utf-32le) 568 (want-encoding-error #(#x01 #x01 #x01) :utf-32le) 569 (want-encoding-error #(#x01 #x01 #x01 #x01 #x01) :utf-32le) 570 (want-encoding-error #(#x01) :utf-32be) 571 (want-encoding-error #(#x01 #x01) :utf-32be) 572 (want-encoding-error #(#x01 #x01 #x01) :utf-32be) 573 (want-encoding-error #(#x01 #x01 #x01 #x01 #x01) :utf-32be)) 574 (when verbose 575 (format t "~&Handling of EOF in the middle of CRLF")) 576 (check (string= #.(string #\Return) 577 (read-flexi-line `(,(char-code #\Return)) '(:ascii :eol-style :crlf)))) 578 (let ((*substitution-char* #\?)) 579 (when verbose 580 (format t "~&Fixed substitution character #\?") 581 (format t "~&:ASCII doesn't have characters with char codes > 127")) 582 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 128 200) :ascii))) 583 (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii))) 584 (when verbose 585 (format t "~&:WINDOWS-1253 doesn't have a characters with codes 170 and 210")) 586 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253))) 587 (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 170 210) :windows-1253))) 588 (when verbose 589 (format t "~&Not a valid UTF-8 sequence")) 590 (check (string= "??" (read-flexi-line '(#xe4 #xf6 #xfc) :utf8)))) 591 (let ((*substitution-char* nil)) 592 (when verbose 593 (format t "~&Variable substitution using USE-VALUE restart") 594 (format t "~&:ASCII doesn't have characters with char codes > 127")) 595 (check (string= "abc" (using-values (#\b #\c) 596 (read-flexi-line `(,(char-code #\a) 128 200) :ascii)))) 597 (check (string= "abc" (using-values (#\b #\c) 598 (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii)))) 599 (when verbose 600 (format t "~&:WINDOWS-1253 doesn't have a characters with codes 170 and 210")) 601 (check (string= "axy" (using-values (#\x #\y) 602 (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253)))) 603 (check (string= "axy" (using-values (#\x #\y) 604 (read-flexi-line* `#(,(char-code #\a) 170 210) :windows-1253)))) 605 (when verbose 606 (format t "~&Not a valid UTF-8 sequence")) 607 (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line '(#xe4 #xf6 #xfc) :utf8)))) 608 (when verbose 609 (format t "~&UTF-8 can't start neither with #b11111110 nor with #b11111111")) 610 (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line '(#b11111110 #b11111111) :utf8)))) 611 (when verbose 612 (format t "~&Only one octet in UTF-16 sequence")) 613 (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16le)))) 614 (when verbose 615 (format t "~&Two octets in UTF-16, but value of resulting word suggests that another word follows")) 616 (check (string= "R" (using-values (#\R) (read-flexi-line '(#x01 #xd8) :utf-16le)))) 617 (when verbose 618 (format t "~&The second word must fit into the [#xdc00; #xdfff] interval, but it is #xdbff")) 619 (check (string= "T" (using-values (#\T) (read-flexi-line '(#x01 #xd8 #xff #xdb) :utf-16le)))) 620 (check (string= "T" (using-values (#\T) (read-flexi-line* #(#x01 #xd8 #xff #xdb) :utf-16le)))) 621 (when verbose 622 (format t "~&The same as for little endian above, but using inverse order of bytes in words")) 623 (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16be)))) 624 (check (string= "R" (using-values (#\R) (read-flexi-line '(#xd8 #x01) :utf-16be)))) 625 (check (string= "T" (using-values (#\T) (read-flexi-line '(#xd8 #x01 #xdb #xff) :utf-16be)))) 626 (check (string= "T" (using-values (#\T) (read-flexi-line* #(#xd8 #x01 #xdb #xff) :utf-16be)))) 627 (when verbose 628 (format t "~&EOF in the middle of a 4-octet sequence in UTF-32")) 629 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01) :utf-32le)))) 630 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01) :utf-32le)))) 631 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01 #x01) :utf-32le)))) 632 (check (string= "aY" (using-values (#\Y) 633 (read-flexi-line `(,(char-code #\a) #x00 #x00 #x00 #x01) :utf-32le)))) 634 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01) :utf-32be)))) 635 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01) :utf-32be)))) 636 (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01 #x01) :utf-32be)))) 637 (check (string= "aY" (using-values (#\Y) 638 (read-flexi-line `(#x00 #x00 #x00 ,(char-code #\a) #x01) :utf-32be))))))) 639 640 (defun unread-char-tests (&key verbose) 641 "Tests whether UNREAD-CHAR behaves as expected." 642 (with-test-suite ("UNREAD-CHAR behaviour." :show-progress-p (and (not verbose) 100)) 643 (flet ((test-one-file (file-name external-format) 644 (when verbose 645 (format t "~& ...and external format ~A" (normalize-external-format external-format))) 646 (with-open-file (in (merge-pathnames file-name *this-file*) 647 :element-type 'flex:octet) 648 (let ((in (make-flexi-stream in :external-format external-format))) 649 (loop repeat 300 650 for char = (read-char in) 651 do (unread-char char in) 652 (check (char= (read-char in) char))))))) 653 (loop for (file-name symbols) in *test-files* 654 when verbose 655 do (format t "~&With file ~S" file-name) 656 do (loop for symbol in symbols 657 do (loop for (file-name . external-format) in (create-file-variants file-name symbol) 658 do (test-one-file file-name external-format))))))) 659 660 (defun column-tests (&key verbose) 661 (with-test-suite ("STREAM-LINE-COLUMN tests" :show-progress-p (not verbose)) 662 (let* ((binary-stream (flexi-streams:make-in-memory-output-stream)) 663 (stream (flexi-streams:make-flexi-stream binary-stream :external-format :iso-8859-1))) 664 (write-sequence "hello" stream) 665 (format stream "~12Tworld") 666 (finish-output stream) 667 (check (string= "hello world" 668 (flexi-streams:octets-to-string 669 (flexi-streams::vector-stream-vector binary-stream) 670 :external-format :iso-8859-1))) 671 (terpri stream) 672 (check (= 0 (flexi-stream-column stream))) 673 (write-sequence "abc" stream) 674 (check (= 3 (flexi-stream-column stream))) 675 (terpri stream) 676 (check (= 0 (flexi-stream-column stream)))))) 677 678 (defun make-external-format-tests (&key verbose) 679 (with-test-suite ("MAKE-EXTERNAL-FORMAT tests" :show-progress-p (not verbose)) 680 (flet ((make-case (real-name &key id name) 681 (list real-name 682 :id id 683 :input-names (list name (string-upcase name) (string-downcase name))))) 684 (let ((cases (append '((:utf-8 :id nil 685 :input-names (:utf8 :utf-8 "utf8" "utf-8" "UTF8" "UTF-8"))) 686 (loop for (name . real-name) in +name-map+ 687 unless (member :code-page (list name real-name)) 688 append (list (make-case real-name :name name) 689 (make-case real-name :name real-name))) 690 (loop for (name . definition) in +shortcut-map+ 691 for key = (car definition) 692 for id = (getf (cdr definition) :id) 693 for expected = (or (cdr (assoc key +name-map+)) key) 694 collect (make-case expected :id id :name name))))) 695 696 (loop for (expected-name . kwargs) in cases 697 for id = (getf kwargs :id) 698 for input-names = (getf kwargs :input-names) 699 do (loop for name in input-names 700 for ext-format = (make-external-format name) 701 do (check (eq (flex:external-format-name ext-format) expected-name)) 702 when id 703 do (check (= (flex:external-format-id ext-format) id)))))) 704 705 (let ((error-cases '("utf-8 " " utf-8" "utf8 " " utf8" "utf89" :utf89 utf89 :code-page nil))) 706 (loop for input-name in error-cases 707 do (with-expected-error (external-format-error) 708 (make-external-format input-name)))))) 709 710 (defun peek-byte-tests (&key verbose) 711 (with-test-suite ("PEEK-BYTE tests" :show-progress-p (not verbose)) 712 (flex:with-input-from-sequence (input #(0 1 2)) 713 (let ((stream (flex:make-flexi-stream input))) 714 ;; If peek-type was specified as 2 we need to peek the first octect equal to 2 715 (check (= 2 (flex::peek-byte stream 2 nil 1))) 716 ;; also, the octet should be unread to the stream so that we can peek it again 717 (check (= 2 (flex::peek-byte stream nil nil nil))))))) 718 719 (defun in-memory-stream-tests (&key verbose) 720 (with-test-suite ("IN-MEMORY-STREAM tests" :show-progress-p (not verbose)) 721 (let ((z (make-array 4))) 722 (read-sequence z (make-in-memory-input-stream #(1 2 3 4))) 723 (check (equalp z #(1 2 3 4))) 724 (read-sequence z (make-in-memory-input-stream '(4 3 2 1))) 725 (check (equalp z #(4 3 2 1))) 726 (read-sequence z (make-in-memory-input-stream #(1 2 3 4) :transformer #'1+)) 727 (check (equalp z #(2 3 4 5))) 728 (read-sequence z (make-in-memory-input-stream '(1 2 3 4) :transformer #'1-)) 729 (check (equalp z #(0 1 2 3)))))) 730 731 (defun run-all-tests (&key verbose) 732 "Runs all tests for FLEXI-STREAMS and returns a true value iff all 733 tests succeeded. VERBOSE is interpreted by the individual test suites 734 above." 735 (let ((successp t)) 736 (macrolet ((run-test-suite (&body body) 737 `(unless (progn ,@body) 738 (setq successp nil)))) 739 (run-test-suite (compare-files :verbose verbose)) 740 (run-test-suite (string-tests :verbose verbose)) 741 (run-test-suite (sequence-tests :verbose verbose)) 742 (run-test-suite (error-handling-tests :verbose verbose)) 743 (run-test-suite (unread-char-tests :verbose verbose)) 744 (run-test-suite (column-tests :verbose verbose)) 745 (run-test-suite (make-external-format-tests :verbose verbose)) 746 (run-test-suite (peek-byte-tests :verbose verbose)) 747 (run-test-suite (in-memory-stream-tests :verbose verbose)) 748 (format t "~2&~:[Some tests failed~;All tests passed~]." successp) 749 successp)))