;; generate test data
(with-open-file (in "eucjp-test.lisp-expr" :direction :input)
(with-open-file (out-eucjp eucjp :direction :output
- :element-type '(unsigned-byte 8)
- :if-exists :supersede)
+ :element-type '(unsigned-byte 8)
+ :if-exists :supersede)
(with-open-file (out-utf8 utf8 :direction :output
- :external-format :utf-8
- :if-exists :supersede)
- (do ((euc (read in nil) (read in nil))
- (ucs (read in nil) (read in nil))
- (i 0 (1+ i)))
- ((or (null euc) (null ucs)))
- ;; write EUC-JP data as binary
- (let ((out out-eucjp))
- (when (>= euc #x10000)
- (write-byte (ldb (byte 8 16) euc) out))
- (when (>= euc #x100)
- (write-byte (ldb (byte 8 8) euc) out))
- (write-byte (ldb (byte 8 0) euc) out)
- (when (= (mod i 32) 31)
- (write-byte #x0a out)))
- ;; trust UTF-8 external format
- (let ((out out-utf8))
- (write-char (code-char ucs) out)
- (when (= (mod i 32) 31)
- (write-char (code-char #x0a) out)))))))
+ :external-format :utf-8
+ :if-exists :supersede)
+ (do ((euc (read in nil) (read in nil))
+ (ucs (read in nil) (read in nil))
+ (i 0 (1+ i)))
+ ((or (null euc) (null ucs)))
+ ;; write EUC-JP data as binary
+ (let ((out out-eucjp))
+ (when (>= euc #x10000)
+ (write-byte (ldb (byte 8 16) euc) out))
+ (when (>= euc #x100)
+ (write-byte (ldb (byte 8 8) euc) out))
+ (write-byte (ldb (byte 8 0) euc) out)
+ (when (= (mod i 32) 31)
+ (write-byte #x0a out)))
+ ;; trust UTF-8 external format
+ (let ((out out-utf8))
+ (write-char (code-char ucs) out)
+ (when (= (mod i 32) 31)
+ (write-char (code-char #x0a) out)))))))
;; check if input works
(with-open-file (in1 eucjp :direction :input
- :external-format :euc-jp)
+ :external-format :euc-jp)
(with-open-file (in2 utf8 :direction :input
- :external-format :utf-8)
+ :external-format :utf-8)
(do ((c1 (read-char in1 nil) (read-char in1 nil))
- (c2 (read-char in2 nil) (read-char in2 nil)))
- ((and (null c1) (null c2)))
- (assert (eql c1 c2)))))
+ (c2 (read-char in2 nil) (read-char in2 nil)))
+ ((and (null c1) (null c2)))
+ (assert (eql c1 c2)))))
;; check if output works
(with-open-file (in utf8 :direction :input
- :external-format :utf-8)
+ :external-format :utf-8)
(with-open-file (out p :direction :output
- :external-format :euc-jp
- :if-exists :supersede)
+ :external-format :euc-jp
+ :if-exists :supersede)
(do ((c (read-char in nil) (read-char in nil)))
- ((null c))
- (write-char c out))))
+ ((null c))
+ (write-char c out))))
(with-open-file (in1 eucjp :direction :input
- :element-type '(unsigned-byte 8))
+ :element-type '(unsigned-byte 8))
(with-open-file (in2 p :direction :input
- :element-type '(unsigned-byte 8))
+ :element-type '(unsigned-byte 8))
(do ((b1 (read-byte in1 nil) (read-byte in1 nil))
- (b2 (read-byte in2 nil) (read-byte in2 nil)))
- ((and (null b1) (null b2)))
- (assert (eql b1 b2)))))
+ (b2 (read-byte in2 nil) (read-byte in2 nil)))
+ ((and (null b1) (null b2)))
+ (assert (eql b1 b2)))))
(delete-file p)
(delete-file eucjp)
(delete-file utf8))
(i 0 (1+ i)))
((or (null euc) (null ucs)))
(let ((o (coerce (cond ((>= euc #x10000)
- (list (ldb (byte 8 16) euc)
- (ldb (byte 8 8) euc)
- (ldb (byte 8 0) euc)))
- ((>= euc #x100)
- (list (ldb (byte 8 8) euc)
- (ldb (byte 8 0) euc)))
- (t (list euc)))
- '(vector (unsigned-byte 8))))
- (s (string (code-char ucs))))
+ (list (ldb (byte 8 16) euc)
+ (ldb (byte 8 8) euc)
+ (ldb (byte 8 0) euc)))
+ ((>= euc #x100)
+ (list (ldb (byte 8 8) euc)
+ (ldb (byte 8 0) euc)))
+ (t (list euc)))
+ '(vector (unsigned-byte 8))))
+ (s (string (code-char ucs))))
(assert (equal (octets-to-string o :external-format :euc-jp) s))
(assert (equal (coerce (string-to-octets s :external-format :euc-jp)
- 'list)
- (coerce o 'list))))))
+ 'list)
+ (coerce o 'list))))))
;;; success
-(sb-ext:quit :unix-status 104)