1
#! /usr/bin/env sscm -C SHIFT_JIS
2
;; -*- buffer-file-coding-system: shift_jisx0213 -*-
3
;; C-x RET c shift_jisx0213 C-x C-f test-enc-sjis.scm
5
;; FileName : test-enc-sjis.scm
6
;; About : unit test for SJIS string
8
;; Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
10
;; All rights reserved.
12
;; Redistribution and use in source and binary forms, with or without
13
;; modification, are permitted provided that the following conditions
16
;; 1. Redistributions of source code must retain the above copyright
17
;; notice, this list of conditions and the following disclaimer.
18
;; 2. Redistributions in binary form must reproduce the above copyright
19
;; notice, this list of conditions and the following disclaimer in the
20
;; documentation and/or other materials provided with the distribution.
21
;; 3. Neither the name of authors nor the names of its contributors
22
;; may be used to endorse or promote products derived from this software
23
;; without specific prior written permission.
25
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
26
;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27
;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
28
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
29
;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
30
;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
31
;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
32
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
33
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
34
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
35
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37
(load "./test/unittest.scm")
41
(assert-equal? "string 1" "���l�ɂ�" (string #\�� #\�l #\�� #\��))
42
(assert-equal? "list->string 1" "3����" (list->string '(#\3 #\�� #\��)))
43
(assert-equal? "string->list 1" '(#\�� #\�� #\��) (string->list "������"))
45
(assert-equal? "string-ref 1" #\�� (string-ref "��hi��͕�" 3))
46
(assert-equal? "make-string 1" "����������" (make-string 5 #\��))
47
(assert-equal? "string-copy 1" "���⍁" (string-copy "���⍁"))
48
(assert-equal? "string-set! 1" "���j��" (string-set!
49
(string-copy "���j��")
56
;; The character after �� is in JIS X 0213 plane 2.
57
(define str1 "��˃�ah�\\\�\n!!���@!")
58
(define str1-list '(#\�� #\� #\�� #\a #\h #\�\ #\\ #\�\ #\n #\! #\! #\�� #\�@ #\!))
60
(assert-equal? "string 2" str1 (apply string str1-list))
61
(assert-equal? "list->string 2" str1-list (string->list str1))
63
;; JIS X 0201 kana (single byte)
64
(assert-equal? "JIS X 0201 kana" #\� (integer->char #xcb))
65
(assert-equal? "JIS X 0201 kana" #xcb (char->integer #\�))
66
(assert-equal? "JIS X 0201 kana" '(#\�) (string->list "�"))
67
(assert-equal? "JIS X 0201 kana" "�" (list->string '(#\�)))
69
(assert-equal? "JIS X 0208 kana #1" #\�� (integer->char #x8384))
70
(assert-equal? "JIS X 0208 kana #2" (car (string->list "��")) (integer->char #x8384))
71
(assert-equal? "JIS X 0208 kana #3" #x8384 (char->integer #\��))
72
(assert-equal? "JIS X 0208 kana #4" #x8384 (char->integer (integer->char #x8384)))
73
(assert-equal? "JIS X 0208 kana #5" '(#\��) (string->list "��"))
74
(assert-equal? "JIS X 0208 kana #6" "��" (list->string '(#\��)))
75
(assert-equal? "JIS X 0208 kana #7" "��" (list->string (string->list "��")))
77
(assert-equal? "JIS X 0201 kana and 0208 kana" '(#\� #\��) (string->list "˃�"))
78
(assert-equal? "JIS X 0201 kana and 0208 kana" "˃�" (list->string '(#\� #\��)))
82
(assert-parseable (tn) "#\\x63")
83
(assert-parse-error (tn) "#\\u0063")
84
(assert-parse-error (tn) "#\\U00000063")
86
(assert-parseable (tn) "\"\\x63\"")
87
(assert-parse-error (tn) "\"\\u0063\"")
88
(assert-parse-error (tn) "\"\\U00000063\"")
90
(assert-parseable (tn) "'a")
91
(assert-parse-error (tn) "'��")