~ubuntu-branches/ubuntu/hardy/sigscheme/hardy-proposed

« back to all changes in this revision

Viewing changes to test/test-enc-sjis.scm

  • Committer: Bazaar Package Importer
  • Author(s): NIIBE Yutaka
  • Date: 2006-05-23 21:46:41 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060523214641-6ix4gz34wpiehub8
Tags: 0.5.0-2
* debian/control (Build-Depends): Added ruby.
  Thanks to Frederik Schueler.  Closes: #368571
* debian/rules (clean): invoke 'distclean' instead of 'clean'.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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
 
4
 
 
5
;;  FileName : test-enc-sjis.scm
 
6
;;  About    : unit test for SJIS string
 
7
;;
 
8
;;  Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
 
9
;;
 
10
;;  All rights reserved.
 
11
;;
 
12
;;  Redistribution and use in source and binary forms, with or without
 
13
;;  modification, are permitted provided that the following conditions
 
14
;;  are met:
 
15
;;
 
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.
 
24
;;
 
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.
 
36
 
 
37
(load "./test/unittest.scm")
 
38
 
 
39
(define tn test-name)
 
40
 
 
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 "������"))
 
44
 
 
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��")
 
50
                                               2
 
51
                                               #\��))
 
52
 
 
53
 
 
54
 
 
55
 
 
56
;; The character after �� is in JIS X 0213 plane 2.
 
57
(define str1 "��˃�ah�\\\�\n!!���@!")
 
58
(define str1-list '(#\�� #\� #\�� #\a #\h #\�\ #\\ #\�\ #\n #\! #\! #\�� #\�@ #\!))
 
59
 
 
60
(assert-equal? "string 2" str1 (apply string str1-list))
 
61
(assert-equal? "list->string 2" str1-list (string->list str1))
 
62
 
 
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 '(#\�)))
 
68
 
 
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 "��")))
 
76
 
 
77
(assert-equal? "JIS X 0201 kana and 0208 kana" '(#\� #\��) (string->list "˃�"))
 
78
(assert-equal? "JIS X 0201 kana and 0208 kana" "˃�" (list->string '(#\� #\��)))
 
79
 
 
80
;; SRFI-75
 
81
(tn "SRFI-75")
 
82
(assert-parseable   (tn) "#\\x63")
 
83
(assert-parse-error (tn) "#\\u0063")
 
84
(assert-parse-error (tn) "#\\U00000063")
 
85
 
 
86
(assert-parseable   (tn) "\"\\x63\"")
 
87
(assert-parse-error (tn) "\"\\u0063\"")
 
88
(assert-parse-error (tn) "\"\\U00000063\"")
 
89
 
 
90
(assert-parseable   (tn) "'a")
 
91
(assert-parse-error (tn) "'��")
 
92
 
 
93
(total-report)