tests/iso-8859-1.pure.lisp

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