tests/enc-jpn.impure.lisp

   1 ;; -*- coding: utf-8 -*-
   2 #-sb-unicode
   3 (sb-ext:exit :code 104)
   4
   5 ;; use "AｱＡあ漾燹釭" for tests
   6 (let ((str (coerce '(#\u0041 #\uff71 #\uff21 #\u3042 #\u6f3e #\u71f9 #\u91ed)
   7                    'string))
   8       (eucjp '(#x41 #x8e #xb1 #xa3 #xc1 #xa4 #xa2 #xdf #xa1 #xe0 #xa1
   9                #x8f #xe3 #xaf))
  10       (sjis '(#x41 #xb1 #x82 #x60 #x82 #xa0 #xe0 #x40 #xe0 #x9f #xfb #xbd))
  11       (file "enc-jpn-test.txt"))
  12   (dolist (pair (list (list eucjp :euc-jp)
  13                       (list sjis :shift_jis)))
  14     (destructuring-bind (bytes enc) pair
  15       ;; check if output works
  16       (with-open-file (s file :direction :output
  17                          :if-exists :supersede :external-format enc)
  18         (write-string str s))
  19       (with-open-file (s file :direction :input
  20                          :element-type '(unsigned-byte 8))
  21         (loop for c in bytes
  22            do (assert (eql (read-byte s) c))))
  23
  24       ;; check if input works
  25       (with-open-file (s file :direction :input :external-format enc)
  26         (loop for c across str
  27            do (assert (eql (read-char s) c))))
  28
  29       ;; check if string conversion works
  30       (assert (equal (coerce (string-to-octets str :external-format enc)
  31                              'list)
  32                      bytes))
  33       (assert (equal (octets-to-string (coerce bytes
  34                                                '(vector (unsigned-byte 8)))
  35                                        :external-format enc)
  36                      str))))
  37
  38   (delete-file file))
  39 ;;; success