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

« back to all changes in this revision

Viewing changes to test/test-enc-eucgeneric.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 EUC-CN
 
2
;; -*- buffer-file-coding-system: euc-jp -*-
 
3
 
 
4
;;  FileName : test-enc-eucgeneric.scm
 
5
;;  About    : unit test for EUC string
 
6
;;
 
7
;;  Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
 
8
;;
 
9
;;  All rights reserved.
 
10
;;
 
11
;;  Redistribution and use in source and binary forms, with or without
 
12
;;  modification, are permitted provided that the following conditions
 
13
;;  are met:
 
14
;;
 
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.
 
23
;;
 
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.
 
35
 
 
36
(load "./test/unittest.scm")
 
37
 
 
38
(define tn test-name)
 
39
 
 
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
 
43
;; systems.
 
44
(assert-equal? "string 1" "���ͤˤ�" (string #\�� #\�� #\�� #\��))
 
45
(assert-equal? "list->string 1" "3����" (list->string '(#\3 #\�� #\��)))
 
46
(assert-equal? "string->list 1" '(#\�� #\�� #\��) (string->list "������"))
 
47
 
 
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))
 
51
 
 
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!
 
55
                                               (string-copy "��ˤ�")
 
56
                                               2
 
57
                                               #\��))
 
58
 
 
59
(define str1 "����ah˽\\˽n!����!")
 
60
(define str1-list '(#\�� #\�� #\a #\h #\˽ #\\ #\˽ #\n #\! #\�� #\�� #\!))
 
61
 
 
62
(assert-equal? "string 2" str1 (apply string str1-list))
 
63
(assert-equal? "list->string 2" str1-list (string->list str1))
 
64
 
 
65
;; SRFI-75
 
66
(tn "SRFI-75")
 
67
(assert-parseable   (tn) "#\\x63")
 
68
(assert-parse-error (tn) "#\\u0063")
 
69
(assert-parse-error (tn) "#\\U00000063")
 
70
 
 
71
(assert-parseable   (tn) "\"\\x63\"")
 
72
(assert-parse-error (tn) "\"\\u0063\"")
 
73
(assert-parse-error (tn) "\"\\U00000063\"")
 
74
 
 
75
(assert-parseable   (tn) "'a")
 
76
(assert-parse-error (tn) "'��")
 
77
 
 
78
(total-report)