In the mips sigtrap hander, and for the case of a break instruction in a
[sbcl.git] / 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