tests/ebcdic-us.pure.lisp

   1 ;;;; This file is for testing external-format functionality for
   2 ;;;; EBCDIC-US, using test machinery which does not have side effects.
   3 ;;;; Note that the tests here reach into unexported functionality, and
   4 ;;;; 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 #+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) '(#xF5 #x25 #xF7))
  65     (test :ebcdic-us '(#\5 #\Newline #\7))
  66     (test (:ebcdic-us :newline :lf) '(#\5 #\Newline #\7))
  67     (test (:ebcdic-us :newline :cr) '(#\5 #\Newline #\7))
  68     (test (:ebcdic-us :newline :crlf) '(#\5 #\Newline #\7)))
  69   (with-output-characters ((:output :lf) '(#\5 #\Linefeed #\7))
  70     (test :ebcdic-us '(#xF5 #x25 #xF7))
  71     (test (:ebcdic-us :newline :lf) '(#xF5 #x25 #xF7))
  72     (test (:ebcdic-us :newline :cr) '(#xF5 #x0d #xF7))
  73     (test (:ebcdic-us :newline :crlf) '(#xF5 #x0d #x25 #xF7)))
  74   (with-input-bytes ((:input :cr) '(#xF5 #x0d #xF7))
  75     (test :ebcdic-us '(#\5 #\Return #\7))
  76     (test (:ebcdic-us :newline :lf) '(#\5 #\Return #\7))
  77     (test (:ebcdic-us :newline :cr) '(#\5 #\Newline #\7))
  78     (test (:ebcdic-us :newline :crlf) '(#\5 #\Return #\7)))
  79   (with-output-characters ((:output :cr) '(#\5 #\Return #\7))
  80     (test :ebcdic-us '(#xF5 #x0d #xF7))
  81     (test (:ebcdic-us :newline :lf) '(#xF5 #x0d #xF7))
  82     (test (:ebcdic-us :newline :cr) '(#xF5 #x0d #xF7))
  83     (test (:ebcdic-us :newline :crlf) '(#xF5 #x0d #xF7)))
  84   (with-input-bytes ((:input :crlf) '(#xF5 #x0d #x25 #xF7))
  85     (test :ebcdic-us '(#\5 #\Return #\Newline #\7))
  86     (test (:ebcdic-us :newline :lf) '(#\5 #\Return #\Newline #\7))
  87     (test (:ebcdic-us :newline :cr) '(#\5 #\Newline #\Newline #\7))
  88     (test (:ebcdic-us :newline :crlf) '(#\5 #\Newline #\7)))
  89   (with-output-characters ((:output :crlf) '(#\5 #\Return #\Linefeed #\7))
  90     (test :ebcdic-us '(#xF5 #x0d #x25 #xF7))
  91     (test (:ebcdic-us :newline :lf) '(#xF5 #x0d #x25 #xF7))
  92     (test (:ebcdic-us :newline :cr) '(#xF5 #x0d #x0d #xF7))
  93     (test (:ebcdic-us :newline :crlf) '(#xF5 #x0d #x0d #x25 #xF7))))
  94
  95 #+sb-unicode
  96 (macrolet ((output-test (chars outxf expected &environment env)
  97              `(progn
  98                 (with-open-file (s *test-path* :element-type 'character
  99                                    :external-format ',outxf
 100                                    :direction :output :if-exists :supersede)
 101                   (handler-bind ((sb-int:character-encoding-error
 102                                   (lambda (c) (use-value "" c))))
 103                     (write-sequence ,chars s)))
 104                 (with-test (:name (,(macroexpand 'name env) :file ,outxf))
 105                   (with-open-file (s *test-path* :element-type '(unsigned-byte 8))
 106                     (let* ((vector (make-array 20 :element-type '(unsigned-byte 8)))
 107                            (count (read-sequence vector s)))
 108                       (assert (equal (map 'list 'identity (subseq vector 0 count)) ,expected)))))
 109                 (with-test (:name (,(macroexpand 'name env) :octets ,outxf))
 110                   (handler-bind ((sb-int:character-encoding-error
 111                                   (lambda (c) (use-value "" c))))
 112                     (let* ((string (coerce chars 'string))
 113                            (octets (sb-ext:string-to-octets string :external-format ',outxf)))
 114                       (assert (typep octets '(simple-array (unsigned-byte 8) 1)))
 115                       (assert (equal (coerce octets 'list) ,expected)))))))
 116            (with-output-characters ((id chars) &body body)
 117              `(let ((chars ,chars))
 118                 (symbol-macrolet ((name ,id))
 119                   (macrolet ((test (outxf expected)
 120                                `(output-test chars ,outxf ,expected)))
 121                     ,@body)))))
 122   (with-output-characters ((:output :invalid :lf) (list #\5 (code-char 512) #\Linefeed #\7))
 123     (test :ebcdic-us '(#xF5 #x25 #xF7))
 124     (test (:ebcdic-us :newline :lf) '(#xF5 #x25 #xF7))
 125     (test (:ebcdic-us :newline :cr) '(#xF5 #x0d #xF7))
 126     (test (:ebcdic-us :newline :crlf) '(#xF5 #x0d #x25 #xF7))))
 127
 128 (macrolet ((test (inxf expected &environment env)
 129              `(with-test (:name (,(macroexpand 'name env) ,inxf))
 130                 (with-open-file (s *test-path* :external-format ',inxf)
 131                   (let* ((string (make-string 10000))
 132                          (count (read-sequence string s)))
 133                     (assert (equal (map 'list 'char-code (subseq string 0 count)) ,expected))))))
 134            (with-test-file ((id bytes) &body body)
 135              `(progn
 136                 (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
 137                                    :direction :output :if-exists :supersede)
 138                   (dolist (byte ,bytes)
 139                     (write-byte byte s)))
 140                 (symbol-macrolet ((name ,id))
 141                   ,@body)))
 142            (tests (size)
 143              `(progn
 144                 (with-test-file ((:input :lf ,size) (contents ,size #x61 '(#x25)))
 145                   (test :ebcdic-us (contents ,size #x2F '(10)))
 146                   (test (:ebcdic-us :newline :lf) (contents ,size #x2F '(10)))
 147                   (test (:ebcdic-us :newline :cr) (contents ,size #x2F '(10)))
 148                   (test (:ebcdic-us :newline :crlf) (contents ,size #x2F '(10))))
 149                 (with-test-file ((:input :cr ,size) (contents ,size #x61 '(#x0d)))
 150                   (test :ebcdic-us (contents ,size #x2F '(13)))
 151                   (test (:ebcdic-us :newline :lf) (contents ,size #x2F '(13)))
 152                   (test (:ebcdic-us :newline :cr) (contents ,size #x2F '(10)))
 153                   (test (:ebcdic-us :newline :crlf) (contents ,size #x2F '(13))))
 154                 (with-test-file ((:input :crlf ,size) (contents ,size #x61 '(#x0d #x25)))
 155                   (test :ebcdic-us (contents ,size #x2F '(13 10)))
 156                   (test (:ebcdic-us :newline :lf) (contents ,size #x2F '(13 10)))
 157                   (test (:ebcdic-us :newline :cr) (contents ,size #x2F '(10 10)))
 158                   (test (:ebcdic-us :newline :crlf) (contents ,(1- size) #x2F '(10)))))))
 159   (flet ((contents (size byte nl)
 160            (let ((bytes (make-array size :initial-element byte)))
 161              (loop for x in nl
 162                    for j from (- (length bytes) (length nl))
 163                    do (setf (aref bytes j) x))
 164              (coerce bytes 'list))))
 165     (tests 2)
 166
 167     (with-test (:name :ansi-stream-cin-buffer-length)
 168       (assert (= sb-impl::+ansi-stream-in-buffer-length+ 512)))
 169
 170     (tests 511)
 171     (tests 512)
 172     (tests 513)
 173
 174     ;; +ANSI-STREAM-IN-BUFFER-EXTRA+ is possibly also relevant.  Can't
 175     ;; test for it as the constant gets shaken out, but it's currently
 176     ;; 4.
 177     (tests 515)
 178     (tests 516)
 179     (tests 517)
 180
 181     (with-test (:name :fd-stream-bytes-per-buffer)
 182       (assert (= sb-impl::+bytes-per-buffer+ 8192)))
 183
 184     (tests 8190)
 185     (tests 8191)
 186     (tests 8192)
 187     (tests 8193)
 188     (tests 8194)))
 189
 190 (macrolet ((test (inxf expected &environment env)
 191              `(progn
 192                 (with-test (:name (,(macroexpand 'name env) ,inxf))
 193                   (with-open-file (s *test-path* :external-format ',inxf)
 194                     (let ((actual
 195                            (cons (file-position s)
 196                                  (loop for char = (read-char s nil nil)
 197                                        while char
 198                                        collect (file-position s)))))
 199                       (assert (equal actual ,expected)))))
 200                 (with-test (:name (,(macroexpand 'name env) unread-char ,inxf))
 201                   (with-open-file (s *test-path* :external-format ',inxf)
 202                     (assert (sb-impl::ansi-stream-cin-buffer s))
 203                     (let ((actual (loop for char = (read-char s nil nil)
 204                                         if (null char) collect (file-position s) and do (loop-finish)
 205                                         do (unread-char char s)
 206                                         collect (file-position s)
 207                                         do (read-char s))))
 208                       (assert (equal actual ,expected)))))
 209                 (with-test (:name (,(macroexpand 'name env) unread-char :io ,inxf))
 210                   (with-open-file (s *test-path* :external-format ',inxf
 211                                      :direction :io :if-exists :overwrite)
 212                     ;; if we reinstate in character buffers for :io character streams,
 213                     ;; make a stream that is unbuffered some other way
 214                     (assert (not (sb-impl::ansi-stream-cin-buffer s)))
 215                     (let ((actual (loop for char = (read-char s nil nil)
 216                                         if (null char) collect (file-position s) and do (loop-finish)
 217                                         do (unread-char char s)
 218                                         collect (file-position s)
 219                                         do (read-char s))))
 220                       (assert (equal actual ,expected)))))))
 221            (with-test-file ((id bytes) &body body)
 222              `(progn
 223                 (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
 224                                    :direction :output :if-exists :supersede)
 225                   (dolist (byte ,bytes)
 226                     (write-byte byte s)))
 227                 (symbol-macrolet ((name ,id))
 228                   ,@body))))
 229   (with-test-file ((file-position :lf) '(#x35 #x25 #x37 #x38 #x25 #x39 #x3a #x25 #x3b))
 230     (test :ebcdic-us (loop for i from 0 to 9 collect i))
 231     (test (:ebcdic-us :newline :lf) (loop for i from 0 to 9 collect i))
 232     (test (:ebcdic-us :newline :cr) (loop for i from 0 to 9 collect i))
 233     (test (:ebcdic-us :newline :crlf) (loop for i from 0 to 9 collect i)))
 234   (with-test-file ((file-position :cr) '(#x35 #x0d #x37 #x38 #x0d #x39 #x3a #x0d #x3b))
 235     (test :ebcdic-us (loop for i from 0 to 9 collect i))
 236     (test (:ebcdic-us :newline :lf) (loop for i from 0 to 9 collect i))
 237     (test (:ebcdic-us :newline :cr) (loop for i from 0 to 9 collect i))
 238     (test (:ebcdic-us :newline :crlf) (loop for i from 0 to 9 collect i)))
 239   (with-test-file ((file-position :crlf) '(#x35 #x0d #x25 #x37 #x38 #x0d #x25 #x39 #x3a #x0d #x25 #x3b))
 240     (test :ebcdic-us (loop for i from 0 to 12 collect i))
 241     (test (:ebcdic-us :newline :lf) (loop for i from 0 to 12 collect i))
 242     (test (:ebcdic-us :newline :cr) (loop for i from 0 to 12 collect i))
 243     (test (:ebcdic-us :newline :crlf) '(0 1 3 4 5 7 8 9 11 12))))
 244
 245 (delete-file *test-path*)