1
#! /usr/bin/env sscm -C EUC-CN
2
;; -*- buffer-file-coding-system: euc-jp -*-
4
;; FileName : test-enc-eucgeneric.scm
5
;; About : unit test for EUC string
7
;; Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
9
;; All rights reserved.
11
;; Redistribution and use in source and binary forms, with or without
12
;; modification, are permitted provided that the following conditions
15
;; 1. Redistributions of source code must retain the above copyright
16
;; notice, this list of conditions and the following disclaimer.
17
;; 2. Redistributions in binary form must reproduce the above copyright
18
;; notice, this list of conditions and the following disclaimer in the
19
;; documentation and/or other materials provided with the distribution.
20
;; 3. Neither the name of authors nor the names of its contributors
21
;; may be used to endorse or promote products derived from this software
22
;; without specific prior written permission.
24
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
25
;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
26
;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
27
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
28
;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
29
;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
30
;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
31
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
32
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
33
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
34
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36
(load "./test/unittest.scm")
40
;; This file provides a fallback test unit for all EUC systems. It's
41
;; just a copy of test-enc-eucjp.scm with EUCJP-specific character
42
;; sequences removed, so some characters may be undefined in other EUC
44
(assert-equal? "string 1" "���ͤˤ�" (string #\�� #\�� #\�� #\��))
45
(assert-equal? "list->string 1" "3����" (list->string '(#\3 #\�� #\��)))
46
(assert-equal? "string->list 1" '(#\�� #\�� #\��) (string->list "������"))
48
;; since single shift is only supported in EUC-JP in SigScheme, the JIS X 0201
49
;; kana character is replaced to JIS x 0208. -- YamaKen 2005-11-25
50
(assert-equal? "string-ref 1" #\�� (string-ref "��hi�����" 3))
52
(assert-equal? "make-string 1" "����������" (make-string 5 #\��))
53
(assert-equal? "string-copy 1" "����" (string-copy "����"))
54
(assert-equal? "string-set! 1" "��˶�" (string-set!
59
(define str1 "����ah˽\\˽n!����!")
60
(define str1-list '(#\�� #\�� #\a #\h #\˽ #\\ #\˽ #\n #\! #\�� #\�� #\!))
62
(assert-equal? "string 2" str1 (apply string str1-list))
63
(assert-equal? "list->string 2" str1-list (string->list str1))
67
(assert-parseable (tn) "#\\x63")
68
(assert-parse-error (tn) "#\\u0063")
69
(assert-parse-error (tn) "#\\U00000063")
71
(assert-parseable (tn) "\"\\x63\"")
72
(assert-parse-error (tn) "\"\\u0063\"")
73
(assert-parse-error (tn) "\"\\U00000063\"")
75
(assert-parseable (tn) "'a")
76
(assert-parse-error (tn) "'��")