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