1.0.39: will be tagged as sbcl_1_0_39
[sbcl.git] / tests / enc-cn.impure.lisp
1 ;;; -*- coding: utf-8 -*-
2 ;;; enc-cn.impure.lisp: test case for enc-cn.lisp and enc-cn-tbl.lisp
3 #-sb-unicode
4 (sb-ext:quit :unix-status 104)
5
6 ;; use "1AAあ胡玥姮" for tests
7 (let ((str (coerce '(#\u0031 #\u0041 #\uff21 #\u3042 #\u80e1 #\u73a5 #\u59ee)
8                    'string))
9       (gbk '(#x31 #x41 #xa3 #xc1 #xa4 #xa2 #xba #xfa #xab #x68 #x8a #xac))
10       (file "enc-cn-test.txt"))
11   (dolist (pair (list (list gbk :gbk)))
12     (destructuring-bind (bytes enc) pair
13       ;; check if output works
14       (with-open-file (s file :direction :output
15                          :if-exists :supersede :external-format enc)
16         (write-string str s))
17       (with-open-file (s file :direction :input
18                          :element-type '(unsigned-byte 8))
19         (loop for c in bytes
20            do (assert (eql (read-byte s) c))))
21
22       ;; check if input works
23       (with-open-file (s file :direction :input :external-format enc)
24         (loop for c across str
25            do (assert (eql (read-char s) c))))
26
27       ;; check if string conversion works
28       (assert (equal (coerce (string-to-octets str :external-format enc)
29                              'list)
30                      bytes))
31       (assert (equal (octets-to-string (coerce bytes
32                                                '(vector (unsigned-byte 8)))
33                                        :external-format enc)
34                      str))))
35   (delete-file file))
36 ;;; success