tests/iso-8859-2.pure.lisp

   1 ;;;; This file is for testing external-format functionality for
   2 ;;;; ISO-8859-2, using test machinery which does not have side
   3 ;;;; effects.  Note that the tests here reach into unexported
   4 ;;;; functionality, and should not be used as a guide for users.
   5
   6 ;;;; This software is part of the SBCL system. See the README file for
   7 ;;;; more information.
   8 ;;;;
   9 ;;;; While most of SBCL is derived from the CMU CL system, the test
  10 ;;;; files (like this one) were written from scratch after the fork
  11 ;;;; from CMU CL.
  12 ;;;;
  13 ;;;; This software is in the public domain and is provided with
  14 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  15 ;;;; more information.
  16
  17 #+(or (not sb-unicode) unicode-lite) (invoke-restart 'run-tests::skip-file)
  18
  19 (defvar *test-path* (scratch-file-name))
  20
  21 (macrolet ((input-test (inxf expected &environment env)
  22              `(progn
  23                 (with-test (:name (,(macroexpand 'name env) :file ,inxf))
  24                   (with-open-file (s *test-path* :external-format ',inxf)
  25                     (let* ((string (make-string 20))
  26                            (count (read-sequence string s)))
  27                       (assert (equal (map 'list 'identity (subseq string 0 count)) ,expected)))))
  28                 (with-test (:name (,(macroexpand 'name env) :octets ,inxf))
  29                   (let ((octets (coerce bytes '(simple-array (unsigned-byte 8) 1))))
  30                     (assert (equal (sb-ext:octets-to-string octets :external-format ',inxf)
  31                                    (coerce ,expected 'string)))))))
  32            (with-input-bytes ((id bytes) &body body)
  33              `(let ((bytes ,bytes))
  34                 (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
  35                                    :direction :output :if-exists :supersede)
  36                   (dolist (byte bytes)
  37                     (write-byte byte s)))
  38                 (symbol-macrolet ((name ,id))
  39                   (macrolet ((test (inxf expected)
  40                                `(input-test ,inxf ,expected)))
  41                     ,@body))))
  42            (output-test (chars outxf expected &environment env)
  43              `(progn
  44                 (with-open-file (s *test-path* :element-type 'character
  45                                    :external-format ',outxf
  46                                    :direction :output :if-exists :supersede)
  47                   (write-sequence ,chars s))
  48                 (with-test (:name (,(macroexpand 'name env) :file ,outxf))
  49                   (with-open-file (s *test-path* :element-type '(unsigned-byte 8))
  50                     (let* ((vector (make-array 20 :element-type '(unsigned-byte 8)))
  51                            (count (read-sequence vector s)))
  52                       (assert (equal (map 'list 'identity (subseq vector 0 count)) ,expected)))))
  53                 (with-test (:name (,(macroexpand 'name env) :octets ,outxf))
  54                   (let* ((string (coerce chars 'string))
  55                          (octets (sb-ext:string-to-octets string :external-format ',outxf)))
  56                     (assert (typep octets '(simple-array (unsigned-byte 8) 1)))
  57                     (assert (equal (coerce octets 'list) ,expected))))))
  58            (with-output-characters ((id chars) &body body)
  59              `(let ((chars ,chars))
  60                 (symbol-macrolet ((name ,id))
  61                   (macrolet ((test (outxf expected)
  62                                `(output-test chars ,outxf ,expected)))
  63                     ,@body)))))
  64   (with-input-bytes ((:input :lf) '(#xb7 #x0a #x37))
  65     (test :iso-8859-2 '(#\CARON #\Newline #\7))
  66     (test (:iso-8859-2 :newline :lf) '(#\CARON #\Newline #\7))
  67     (test (:iso-8859-2 :newline :cr) '(#\CARON #\Newline #\7))
  68     (test (:iso-8859-2 :newline :crlf) '(#\CARON #\Newline #\7)))
  69   (with-output-characters ((:output :lf) '(#\CARON #\Linefeed #\7))
  70     (test :iso-8859-2 '(#xb7 #x0a #x37))
  71     (test (:iso-8859-2 :newline :lf) '(#xb7 #x0a #x37))
  72     (test (:iso-8859-2 :newline :cr) '(#xb7 #x0d #x37))
  73     (test (:iso-8859-2 :newline :crlf) '(#xb7 #x0d #x0a #x37)))
  74   (with-input-bytes ((:input :cr) '(#xb7 #x0d #x37))
  75     (test :iso-8859-2 '(#\CARON #\Return #\7))
  76     (test (:iso-8859-2 :newline :lf) '(#\CARON #\Return #\7))
  77     (test (:iso-8859-2 :newline :cr) '(#\CARON #\Newline #\7))
  78     (test (:iso-8859-2 :newline :crlf) '(#\CARON #\Return #\7)))
  79   (with-output-characters ((:output :cr) '(#\CARON #\Return #\7))
  80     (test :iso-8859-2 '(#xb7 #x0d #x37))
  81     (test (:iso-8859-2 :newline :lf) '(#xb7 #x0d #x37))
  82     (test (:iso-8859-2 :newline :cr) '(#xb7 #x0d #x37))
  83     (test (:iso-8859-2 :newline :crlf) '(#xb7 #x0d #x37)))
  84   (with-input-bytes ((:input :crlf) '(#xb7 #x0d #x0a #x37))
  85     (test :iso-8859-2 '(#\CARON #\Return #\Newline #\7))
  86     (test (:iso-8859-2 :newline :lf) '(#\CARON #\Return #\Newline #\7))
  87     (test (:iso-8859-2 :newline :cr) '(#\CARON #\Newline #\Newline #\7))
  88     (test (:iso-8859-2 :newline :crlf) '(#\CARON #\Newline #\7)))
  89   (with-output-characters ((:output :crlf) '(#\CARON #\Return #\Linefeed #\7))
  90     (test :iso-8859-2 '(#xb7 #x0d #x0a #x37))
  91     (test (:iso-8859-2 :newline :lf) '(#xb7 #x0d #x0a #x37))
  92     (test (:iso-8859-2 :newline :cr) '(#xb7 #x0d #x0d #x37))
  93     (test (:iso-8859-2 :newline :crlf) '(#xb7 #x0d #x0d #x0a #x37))))
  94
  95 (macrolet ((output-test (chars outxf expected &environment env)
  96              `(progn
  97                 (with-open-file (s *test-path* :element-type 'character
  98                                    :external-format ',outxf
  99                                    :direction :output :if-exists :supersede)
 100                   (handler-bind ((sb-int:character-encoding-error
 101                                   (lambda (c) (use-value "" c))))
 102                     (write-sequence ,chars s)))
 103                 (with-test (:name (,(macroexpand 'name env) :file ,outxf))
 104                   (with-open-file (s *test-path* :element-type '(unsigned-byte 8))
 105                     (let* ((vector (make-array 20 :element-type '(unsigned-byte 8)))
 106                            (count (read-sequence vector s)))
 107                       (assert (equal (map 'list 'identity (subseq vector 0 count)) ,expected)))))
 108                 (with-test (:name (,(macroexpand 'name env) :octets ,outxf))
 109                   (handler-bind ((sb-int:character-encoding-error
 110                                   (lambda (c) (use-value "" c))))
 111                     (let* ((string (coerce chars 'string))
 112                            (octets (sb-ext:string-to-octets string :external-format ',outxf)))
 113                       (assert (typep octets '(simple-array (unsigned-byte 8) 1)))
 114                       (assert (equal (coerce octets 'list) ,expected)))))))
 115            (with-output-characters ((id chars) &body body)
 116              `(let ((chars ,chars))
 117                 (symbol-macrolet ((name ,id))
 118                   (macrolet ((test (outxf expected)
 119                                `(output-test chars ,outxf ,expected)))
 120                     ,@body)))))
 121   (with-output-characters ((:output :invalid :lf) (list #\CARON (code-char 512) #\Linefeed #\7))
 122     (test :iso-8859-2 '(#xb7 #x0a #x37))
 123     (test (:iso-8859-2 :replacement #\?) '(#xb7 #x3f #x0a #x37))
 124     (test (:iso-8859-2 :newline :lf) '(#xb7 #x0a #x37))
 125     (test (:iso-8859-2 :newline :lf :replacement #\?) '(#xb7 #x3f #x0a #x37))
 126     (test (:iso-8859-2 :newline :cr) '(#xb7 #x0d #x37))
 127     (test (:iso-8859-2 :newline :cr :replacement #\?) '(#xb7 #x3f #x0d #x37))
 128     (test (:iso-8859-2 :newline :crlf) '(#xb7 #x0d #x0a #x37))
 129     (test (:iso-8859-2 :newline :crlf :replacement #\?) '(#xb7 #x3f #x0d #x0a #x37))))
 130
 131 (macrolet ((test (inxf expected &environment env)
 132              `(with-test (:name (,(macroexpand 'name env) ,inxf))
 133                 (with-open-file (s *test-path* :external-format ',inxf)
 134                   (let* ((string (make-string 10000))
 135                          (count (read-sequence string s)))
 136                     (assert (equal (map 'list 'char-code (subseq string 0 count)) ,expected))))))
 137            (with-test-file ((id bytes) &body body)
 138              `(progn
 139                 (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
 140                                    :direction :output :if-exists :supersede)
 141                   (dolist (byte ,bytes)
 142                     (write-byte byte s)))
 143                 (symbol-macrolet ((name ,id))
 144                   ,@body)))
 145            (tests (size)
 146              `(progn
 147                 (with-test-file ((:input :lf ,size) (contents ,size '(#x0a)))
 148                   (test :iso-8859-2 (contents ,size '(10)))
 149                   (test (:iso-8859-2 :newline :lf) (contents ,size '(10)))
 150                   (test (:iso-8859-2 :newline :cr) (contents ,size '(10)))
 151                   (test (:iso-8859-2 :newline :crlf) (contents ,size '(10))))
 152                 (with-test-file ((:input :cr ,size) (contents ,size '(#x0d)))
 153                   (test :iso-8859-2 (contents ,size '(13)))
 154                   (test (:iso-8859-2 :newline :lf) (contents ,size '(13)))
 155                   (test (:iso-8859-2 :newline :cr) (contents ,size '(10)))
 156                   (test (:iso-8859-2 :newline :crlf) (contents ,size '(13))))
 157                 (with-test-file ((:input :crlf ,size) (contents ,size '(#x0d #x0a)))
 158                   (test :iso-8859-2 (contents ,size '(13 10)))
 159                   (test (:iso-8859-2 :newline :lf) (contents ,size '(13 10)))
 160                   (test (:iso-8859-2 :newline :cr) (contents ,size '(10 10)))
 161                   (test (:iso-8859-2 :newline :crlf) (contents ,(1- size) '(10)))))))
 162   (flet ((contents (size nl)
 163            (let ((bytes (make-array size :initial-element #x61)))
 164              (loop for x in nl
 165                    for j from (- (length bytes) (length nl))
 166                    do (setf (aref bytes j) x))
 167              (coerce bytes 'list))))
 168     (tests 2)
 169
 170     (with-test (:name :ansi-stream-cin-buffer-length)
 171       (assert (= sb-impl::+ansi-stream-in-buffer-length+ 512)))
 172
 173     (tests 511)
 174     (tests 512)
 175     (tests 513)
 176
 177     ;; +ANSI-STREAM-IN-BUFFER-EXTRA+ is possibly also relevant.  Can't
 178     ;; test for it as the constant gets shaken out, but it's currently
 179     ;; 4.
 180     (tests 515)
 181     (tests 516)
 182     (tests 517)
 183
 184     (with-test (:name :fd-stream-bytes-per-buffer)
 185       (assert (= sb-impl::+bytes-per-buffer+ 8192)))
 186
 187     (tests 8190)
 188     (tests 8191)
 189     (tests 8192)
 190     (tests 8193)
 191     (tests 8194)))
 192
 193 (macrolet ((test (inxf expected &environment env)
 194              `(progn
 195                 (with-test (:name (,(macroexpand 'name env) ,inxf))
 196                   (with-open-file (s *test-path* :external-format ',inxf)
 197                     (let ((actual
 198                            (cons (file-position s)
 199                                  (loop for char = (read-char s nil nil)
 200                                        while char
 201                                        collect (file-position s)))))
 202                       (assert (equal actual ,expected)))))
 203                 (with-test (:name (,(macroexpand 'name env) unread-char ,inxf))
 204                   (with-open-file (s *test-path* :external-format ',inxf)
 205                     (assert (sb-impl::ansi-stream-cin-buffer s))
 206                     (let ((actual (loop for char = (read-char s nil nil)
 207                                         if (null char) collect (file-position s) and do (loop-finish)
 208                                         do (unread-char char s)
 209                                         collect (file-position s)
 210                                         do (read-char s))))
 211                       (assert (equal actual ,expected)))))
 212                 (with-test (:name (,(macroexpand 'name env) unread-char :io ,inxf))
 213                   (with-open-file (s *test-path* :external-format ',inxf
 214                                      :direction :io :if-exists :overwrite)
 215                     ;; if we reinstate in character buffers for :io character streams,
 216                     ;; make a stream that is unbuffered some other way
 217                     (assert (not (sb-impl::ansi-stream-cin-buffer s)))
 218                     (let ((actual (loop for char = (read-char s nil nil)
 219                                         if (null char) collect (file-position s) and do (loop-finish)
 220                                         do (unread-char char s)
 221                                         collect (file-position s)
 222                                         do (read-char s))))
 223                       (assert (equal actual ,expected)))))))
 224            (with-test-file ((id bytes) &body body)
 225              `(progn
 226                 (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
 227                                    :direction :output :if-exists :supersede)
 228                   (dolist (byte ,bytes)
 229                     (write-byte byte s)))
 230                 (symbol-macrolet ((name ,id))
 231                   ,@body))))
 232   (with-test-file ((file-position :lf) '(#xb7 #x0a #x37 #x38 #x0a #x39 #x3a #x0a #x3b))
 233     (test :iso-8859-2 (loop for i from 0 to 9 collect i))
 234     (test (:iso-8859-2 :newline :lf) (loop for i from 0 to 9 collect i))
 235     (test (:iso-8859-2 :newline :cr) (loop for i from 0 to 9 collect i))
 236     (test (:iso-8859-2 :newline :crlf) (loop for i from 0 to 9 collect i)))
 237   (with-test-file ((file-position :cr) '(#xb7 #x0d #x37 #x38 #x0d #x39 #x3a #x0d #x3b))
 238     (test :iso-8859-2 (loop for i from 0 to 9 collect i))
 239     (test (:iso-8859-2 :newline :lf) (loop for i from 0 to 9 collect i))
 240     (test (:iso-8859-2 :newline :cr) (loop for i from 0 to 9 collect i))
 241     (test (:iso-8859-2 :newline :crlf) (loop for i from 0 to 9 collect i)))
 242   (with-test-file ((file-position :crlf) '(#xb7 #x0d #x0a #x37 #x38 #x0d #x0a #x39 #x3a #x0d #x0a #x3b))
 243     (test :iso-8859-2 (loop for i from 0 to 12 collect i))
 244     (test (:iso-8859-2 :newline :lf) (loop for i from 0 to 12 collect i))
 245     (test (:iso-8859-2 :newline :cr) (loop for i from 0 to 12 collect i))
 246     (test (:iso-8859-2 :newline :crlf) '(0 1 3 4 5 7 8 9 11 12))))
 247
 248 (macrolet ((output-test (chars outxf expected &environment env)
 249              `(progn
 250                 (with-test (:name (,(macroexpand 'name env) file-string-length ,outxf))
 251                   (let ((string (coerce ,chars 'string)))
 252                     (with-open-file (s *test-path* :element-type 'character
 253                                        :external-format ',outxf
 254                                        :direction :output :if-exists :supersede)
 255                       (handler-bind ((sb-int:character-encoding-error
 256                                       (lambda (c) (use-value "" c))))
 257                         (let ((pos (file-position s))
 258                               (len (file-string-length s string)))
 259                           (let ((actual
 260                                  (loop for index from 0 below (length string)
 261                                        for char = (char string index)
 262                                        for thislen = (file-string-length s char)
 263                                        for thisstringlen = (file-string-length s (subseq string index))
 264                                        if (null thisstringlen) do (assert (some 'null (subseq ,expected index))) else do (assert (notany 'null (subseq ,expected index)))
 265                                        collect thislen
 266                                        if (and (null len) thisstringlen) do (setf len (+ pos thisstringlen))
 267                                        if thisstringlen do (assert (= (+ pos thisstringlen) len))
 268                                        do (write-char char s)
 269                                        if thislen do (assert (= (+ pos thislen) (file-position s)))
 270                                        do (setf pos (file-position s)))))
 271                             (assert (equal actual ,expected))))))))))
 272            (with-output-characters ((id chars) &body body)
 273              `(let ((chars ,chars))
 274                 (symbol-macrolet ((name ,id))
 275                   (macrolet ((test (outxf expected)
 276                                `(output-test chars ,outxf ,expected)))
 277                     ,@body)))))
 278   (with-output-characters ((:output :lf) (list #\5 #\Linefeed #\7))
 279     (test :iso-8859-2 '(1 1 1))
 280     (test (:iso-8859-2 :newline :lf) '(1 1 1))
 281     (test (:iso-8859-2 :newline :cr) '(1 1 1))
 282     (test (:iso-8859-2 :newline :crlf) '(1 2 1)))
 283   (with-output-characters ((:output :invalid :lf) (list #\5 (code-char #xa1) #\Linefeed #\7))
 284     ;; A sufficiently-smart streams implementation could statically determine the lengths
 285     ;; of replacement characters given as part of the external format
 286     (test :iso-8859-2 '(1 nil 1 1))
 287     (test (:iso-8859-2 :replacement #\?) '(1 nil 1 1))
 288     (test (:iso-8859-2 :newline :lf) '(1 nil 1 1))
 289     (test (:iso-8859-2 :newline :lf :replacement #\?) '(1 nil 1 1))
 290     (test (:iso-8859-2 :newline :cr) '(1 nil 1 1))
 291     (test (:iso-8859-2 :newline :cr :replacement #\?) '(1 nil 1 1))
 292     (test (:iso-8859-2 :newline :crlf) '(1 nil 2 1))
 293     (test (:iso-8859-2 :newline :crlf :replacement #\?) '(1 nil 2 1))))
 294
 295 (delete-file *test-path*)