tests/eucjp.impure.lisp

   1 #-sb-unicode
   2 (sb-ext:quit :unix-status 104)
   3
   4 (let ((p "eucjp-test.data")
   5       (eucjp "eucjp-test-eucjp.data")
   6       (utf8 "eucjp-test-utf8.data"))
   7
   8   ;; generate test data
   9   (with-open-file (in "eucjp-test.lisp-expr" :direction :input)
  10     (with-open-file (out-eucjp eucjp :direction :output
  11                                :element-type '(unsigned-byte 8)
  12                                :if-exists :supersede)
  13       (with-open-file (out-utf8 utf8 :direction :output
  14                                 :external-format :utf-8
  15                                 :if-exists :supersede)
  16         (do ((euc (read in nil) (read in nil))
  17              (ucs (read in nil) (read in nil))
  18              (i 0 (1+ i)))
  19             ((or (null euc) (null ucs)))
  20           ;; write EUC-JP data as binary
  21           (let ((out out-eucjp))
  22             (when (>= euc #x10000)
  23               (write-byte (ldb (byte 8 16) euc) out))
  24             (when (>= euc #x100)
  25               (write-byte (ldb (byte 8 8) euc) out))
  26             (write-byte (ldb (byte 8 0) euc) out)
  27             (when (= (mod i 32) 31)
  28               (write-byte #x0a out)))
  29           ;; trust UTF-8 external format
  30           (let ((out out-utf8))
  31             (write-char (code-char ucs) out)
  32             (when (= (mod i 32) 31)
  33               (write-char (code-char #x0a) out)))))))
  34
  35   ;; check if input works
  36   (with-open-file (in1 eucjp :direction :input
  37                        :external-format :euc-jp)
  38     (with-open-file (in2 utf8 :direction :input
  39                          :external-format :utf-8)
  40       (do ((c1 (read-char in1 nil) (read-char in1 nil))
  41            (c2 (read-char in2 nil) (read-char in2 nil)))
  42           ((and (null c1) (null c2)))
  43         (assert (eql c1 c2)))))
  44
  45   ;; check if output works
  46   (with-open-file (in utf8 :direction :input
  47                       :external-format :utf-8)
  48     (with-open-file (out p :direction :output
  49                          :external-format :euc-jp
  50                          :if-exists :supersede)
  51       (do ((c (read-char in nil) (read-char in nil)))
  52           ((null c))
  53         (write-char c out))))
  54   (with-open-file (in1 eucjp :direction :input
  55                        :element-type '(unsigned-byte 8))
  56     (with-open-file (in2 p :direction :input
  57                          :element-type '(unsigned-byte 8))
  58       (do ((b1 (read-byte in1 nil) (read-byte in1 nil))
  59            (b2 (read-byte in2 nil) (read-byte in2 nil)))
  60           ((and (null b1) (null b2)))
  61         (assert (eql b1 b2)))))
  62   (delete-file p)
  63   (delete-file eucjp)
  64   (delete-file utf8))
  65
  66 ;; check if string conversion works
  67 (with-open-file (in "eucjp-test.lisp-expr" :direction :input)
  68   (do ((euc (read in nil) (read in nil))
  69        (ucs (read in nil) (read in nil))
  70        (i 0 (1+ i)))
  71       ((or (null euc) (null ucs)))
  72     (let ((o (coerce (cond ((>= euc #x10000)
  73                             (list (ldb (byte 8 16) euc)
  74                                   (ldb (byte 8 8) euc)
  75                                   (ldb (byte 8 0) euc)))
  76                            ((>= euc #x100)
  77                             (list (ldb (byte 8 8) euc)
  78                                   (ldb (byte 8 0) euc)))
  79                            (t (list euc)))
  80                      '(vector (unsigned-byte 8))))
  81           (s (string (code-char ucs))))
  82       (assert (equal (octets-to-string o :external-format :euc-jp) s))
  83       (assert (equal (coerce (string-to-octets s :external-format :euc-jp)
  84                              'list)
  85                      (coerce o 'list))))))
  86 ;;; success
  87 (sb-ext:quit :unix-status 104)