tests/utf-32le.pure.lisp

   1 ;;;; This file is for testing external-format functionality for
   2 ;;;; little-endian UTF-32, using test machinery which does not have
   3 ;;;; side 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 #-sb-unicode (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                     (handler-bind ((sb-int:character-decoding-error
  26                                     (lambda (c) (use-value "" c))))
  27                       (let* ((string (make-string 20))
  28                              (count (read-sequence string s)))
  29                         (assert (equal (map 'list 'identity (subseq string 0 count)) ,expected))))))
  30                 (with-test (:name (,(macroexpand 'name env) :octets ,inxf))
  31                   (handler-bind ((sb-int:character-decoding-error
  32                                   (lambda (c) (use-value "" c))))
  33                     (let ((octets (coerce bytes '(simple-array (unsigned-byte 8) 1))))
  34                       (assert (equal (sb-ext:octets-to-string octets :external-format ',inxf)
  35                                      (coerce ,expected 'string))))))))
  36            (with-input-bytes ((id bytes) &body body)
  37              `(let ((bytes ,bytes))
  38                 (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
  39                                    :direction :output :if-exists :supersede)
  40                   (dolist (byte bytes)
  41                     (write-byte byte s)))
  42                 (symbol-macrolet ((name ,id))
  43                   (macrolet ((test (inxf expected)
  44                                `(input-test ,inxf ,expected)))
  45                     ,@body)))))
  46   (with-input-bytes ((:input :invalid) (list #x35 #x00 #x00 #x00
  47                                              #xff #xff #x00 #x00
  48                                              #x37 #x00 #x00 #x00))
  49     (test :utf-32le '(#\5 #\7))
  50     (test (:utf-32le :replacement #\?) '(#\5 #\? #\7)))
  51   (with-input-bytes ((:input :multiple-invalid) (list #x35 #x00 #x00 #x00
  52                                                       #xff #xff #x00 #x00
  53                                                       #xff #xff #x00 #x00
  54                                                       #x37 #x00 #x00 #x00))
  55     (test :utf-32le '(#\5 #\7))
  56     (test (:utf-32le :replacement #\?) '(#\5 #\? #\? #\7)))
  57   (with-input-bytes ((:input :invalid-units1) (list #x35 #x00 #x00 #x00
  58                                                     #x00))
  59     (test :utf-32le '(#\5))
  60     (test (:utf-32le :replacement #\?) '(#\5 #\?)))
  61   (with-input-bytes ((:input :invalid-units2) (list #x35 #x00 #x00 #x00
  62                                                     #x00 #x00))
  63     (test :utf-32le '(#\5))
  64     (test (:utf-32le :replacement #\?) '(#\5 #\?)))
  65   (with-input-bytes ((:input :invalid-units3) (list #x35 #x00 #x00 #x00
  66                                                     #x00 #x00 #x00))
  67     (test :utf-32le '(#\5))
  68     (test (:utf-32le :replacement #\?) '(#\5 #\?)))
  69   (with-input-bytes ((:input :invalid-then-invalid-units) (list #xff #xff #x00 #x00
  70                                                                 #x00))
  71     (test :utf-32le '())
  72     (test (:utf-32le :replacement #\?) '(#\? #\?))))
  73
  74 (macrolet ((output-test (chars outxf expected &environment env)
  75              `(progn
  76                 (with-test (:name (,(macroexpand 'name env) file-string-length ,outxf))
  77                   (let ((string (coerce ,chars 'string)))
  78                     (with-open-file (s *test-path* :element-type 'character
  79                                        :external-format ',outxf
  80                                        :direction :output :if-exists :supersede)
  81                       (handler-bind ((sb-int:character-encoding-error
  82                                       (lambda (c) (use-value "" c))))
  83                         (let ((pos (file-position s))
  84                               (len (file-string-length s string)))
  85                           (let ((actual
  86                                  (loop for index from 0 below (length string)
  87                                        for char = (char string index)
  88                                        for thislen = (file-string-length s char)
  89                                        for thisstringlen = (file-string-length s (subseq string index))
  90                                        if (null thisstringlen) do (assert (some 'null (subseq ,expected index))) else do (assert (notany 'null (subseq ,expected index)))
  91                                        collect thislen
  92                                        if (and (null len) thisstringlen) do (setf len (+ pos thisstringlen))
  93                                        if thisstringlen do (assert (= (+ pos thisstringlen) len))
  94                                        do (write-char char s)
  95                                        if thislen do (assert (= (+ pos thislen) (file-position s)))
  96                                        do (setf pos (file-position s)))))
  97                             (assert (equal actual ,expected))))))))))
  98            (with-output-characters ((id chars) &body body)
  99              `(let ((chars ,chars))
 100                 (symbol-macrolet ((name ,id))
 101                   (macrolet ((test (outxf expected)
 102                                `(output-test chars ,outxf ,expected)))
 103                     ,@body)))))
 104   (with-output-characters ((:output :lf) (list #\5 #\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Linefeed #\7))
 105     (test :utf-32le '(4 4 4 4)))
 106   (with-output-characters ((:output :invalid :lf) (list #\5 (code-char #xdb00) (code-char #x12345) #\Linefeed #\7))
 107     ;; A sufficiently-smart streams implementation could statically determine the lengths
 108     ;; of replacement characters given as part of the external format
 109     (test :utf-32le '(4 nil 4 4 4))
 110     (test (:utf-32le :replacement #\?) '(4 nil 4 4 4))))