← Back to branch summary

~ubuntu-branches/ubuntu/maverick/uim/maverick

« back to all changes in this revision

Viewing changes to sigscheme/test/test-formatplus.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2008-06-25 19:56:33 UTC
  • mfrom: (3.1.18 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080625195633-8jljph4rfq00l8o7
Tags: 1:1.5.1-2
http://bugs.debian.org/482659
http://bugs.debian.org/483078
* uim-tcode: provide tutcode-custom.scm, tutcode-bushudic.scm
  and tutcode-rule.scm (Closes: #482659)
* Fix FTBFS: segv during compile (Closes: #483078).
  I personally think this bug is not specific for uim but is a optimization
  problem on gcc-4.3.1. (https://bugs.freedesktop.org/show_bug.cgi?id=16477)

Show diffs side-by-side

added added

removed removed

Lines of Context:
sigscheme/test/test-formatplus.scm
 
1
;;  Filename : test-formatplus.scm
 
2
;;  About    : unit test for SigScheme-specific procedure format+
 
3
;;
 
4
;;  Copyright (C) 2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
 
5
;;  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
 
6
;;
 
7
;;  All rights reserved.
 
8
;;
 
9
;;  Redistribution and use in source and binary forms, with or without
 
10
;;  modification, are permitted provided that the following conditions
 
11
;;  are met:
 
12
;;
 
13
;;  1. Redistributions of source code must retain the above copyright
 
14
;;     notice, this list of conditions and the following disclaimer.
 
15
;;  2. Redistributions in binary form must reproduce the above copyright
 
16
;;     notice, this list of conditions and the following disclaimer in the
 
17
;;     documentation and/or other materials provided with the distribution.
 
18
;;  3. Neither the name of authors nor the names of its contributors
 
19
;;     may be used to endorse or promote products derived from this software
 
20
;;     without specific prior written permission.
 
21
;;
 
22
;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
 
23
;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 
24
;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
25
;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
 
26
;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 
27
;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 
28
;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 
29
;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 
30
;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 
31
;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 
32
;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
33
 
 
34
;; All tests in this file are passed against r3170 (new repository)
 
35
 
 
36
(require-extension (unittest))
 
37
 
 
38
(require-extension (srfi 48))
 
39
 
 
40
(if (not (symbol-bound? 'format+))
 
41
    (test-skip "format+ is not enabled"))
 
42
 
 
43
;; test SRFI-48 compatible part of format+
 
44
(define format format+)
 
45
(load "./test/test-srfi48.scm")
 
46
(newline)
 
47
 
 
48
(define tn test-name)
 
49
 
 
50
(tn "format+ ~d")
 
51
(assert-error  (tn) (lambda () (format+ "0128d"    1)))
 
52
(assert-error  (tn) (lambda () (format+ "0128,1d"  1)))
 
53
(assert-error  (tn) (lambda () (format+ "1,0128d"  1)))
 
54
(assert-error  (tn) (lambda () (format+ "01024d"   1)))
 
55
(assert-error  (tn) (lambda () (format+ "01024,1d" 1)))
 
56
(assert-error  (tn) (lambda () (format+ "1,01024d" 1)))
 
57
(assert-equal? (tn) "-100" (format+ "~0d" -100))
 
58
(assert-equal? (tn) "-10"  (format+ "~0d" -10))
 
59
(assert-equal? (tn) "-1"   (format+ "~0d" -1))
 
60
(assert-equal? (tn) "0"    (format+ "~0d" 0))
 
61
(assert-equal? (tn) "1"    (format+ "~0d" 1))
 
62
(assert-equal? (tn) "10"   (format+ "~0d" 10))
 
63
(assert-equal? (tn) "100"  (format+ "~0d" 100))
 
64
 
 
65
(assert-equal? (tn) "-100" (format+ "~03d" -100))
 
66
(assert-equal? (tn) "-10"  (format+ "~03d" -10))
 
67
(assert-equal? (tn) "-01"  (format+ "~03d" -1))
 
68
(assert-equal? (tn) "000"  (format+ "~03d" 0))
 
69
(assert-equal? (tn) "001"  (format+ "~03d" 1))
 
70
(assert-equal? (tn) "010"  (format+ "~03d" 10))
 
71
(assert-equal? (tn) "100"  (format+ "~03d" 100))
 
72
 
 
73
(assert-equal? (tn)
 
74
               "                                                                                                                            123"
 
75
               (format+ "~127d" 123))
 
76
(assert-equal? (tn)
 
77
               "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123"
 
78
               (format+ "~0127d" 123))
 
79
 
 
80
(tn "format+ ~x")
 
81
(assert-error  (tn) (lambda () (format+ "0128x"    1)))
 
82
(assert-error  (tn) (lambda () (format+ "0128,1x"  1)))
 
83
(assert-error  (tn) (lambda () (format+ "1,0128x"  1)))
 
84
(assert-error  (tn) (lambda () (format+ "01024x"   1)))
 
85
(assert-error  (tn) (lambda () (format+ "01024,1x" 1)))
 
86
(assert-error  (tn) (lambda () (format+ "1,01024x" 1)))
 
87
(assert-equal? (tn) "-64"  (format+ "~0x" -100))
 
88
(assert-equal? (tn) "-a"   (format+ "~0x" -10))
 
89
(assert-equal? (tn) "-1"   (format+ "~0x" -1))
 
90
(assert-equal? (tn) "0"    (format+ "~0x" 0))
 
91
(assert-equal? (tn) "1"    (format+ "~0x" 1))
 
92
(assert-equal? (tn) "a"    (format+ "~0x" 10))
 
93
(assert-equal? (tn) "64"   (format+ "~0x" 100))
 
94
 
 
95
(assert-equal? (tn) "-64"  (format+ "~03x" -100))
 
96
(assert-equal? (tn) "-0a"  (format+ "~03x" -10))
 
97
(assert-equal? (tn) "-01"  (format+ "~03x" -1))
 
98
(assert-equal? (tn) "000"  (format+ "~03x" 0))
 
99
(assert-equal? (tn) "001"  (format+ "~03x" 1))
 
100
(assert-equal? (tn) "00a"  (format+ "~03x" 10))
 
101
(assert-equal? (tn) "064"  (format+ "~03x" 100))
 
102
 
 
103
(assert-equal? (tn)
 
104
               "                                                                                                                            1ac"
 
105
               (format+ "~127x" #x1ac))
 
106
(assert-equal? (tn)
 
107
               "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001ac"
 
108
               (format+ "~0127x" #x1ac))
 
109
 
 
110
(tn "format+ ~o")
 
111
(assert-error  (tn) (lambda () (format+ "0128o"    1)))
 
112
(assert-error  (tn) (lambda () (format+ "0128,1o"  1)))
 
113
(assert-error  (tn) (lambda () (format+ "1,0128o"  1)))
 
114
(assert-error  (tn) (lambda () (format+ "01024o"   1)))
 
115
(assert-error  (tn) (lambda () (format+ "01024,1o" 1)))
 
116
(assert-error  (tn) (lambda () (format+ "1,01024o" 1)))
 
117
(assert-equal? (tn) "-144" (format+ "~0o" -100))
 
118
(assert-equal? (tn) "-12"  (format+ "~0o" -10))
 
119
(assert-equal? (tn) "-1"   (format+ "~0o" -1))
 
120
(assert-equal? (tn) "0"    (format+ "~0o" 0))
 
121
(assert-equal? (tn) "1"    (format+ "~0o" 1))
 
122
(assert-equal? (tn) "12"   (format+ "~0o" 10))
 
123
(assert-equal? (tn) "144"  (format+ "~0o" 100))
 
124
 
 
125
(assert-equal? (tn) "-144" (format+ "~03o" -100))
 
126
(assert-equal? (tn) "-12"  (format+ "~03o" -10))
 
127
(assert-equal? (tn) "-01"  (format+ "~03o" -1))
 
128
(assert-equal? (tn) "000"  (format+ "~03o" 0))
 
129
(assert-equal? (tn) "001"  (format+ "~03o" 1))
 
130
(assert-equal? (tn) "012"  (format+ "~03o" 10))
 
131
(assert-equal? (tn) "144"  (format+ "~03o" 100))
 
132
 
 
133
(assert-equal? (tn)
 
134
               "                                                                                                                            123"
 
135
               (format+ "~127o" #o123))
 
136
(assert-equal? (tn)
 
137
               "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123"
 
138
               (format+ "~0127o" #o123))
 
139
 
 
140
(tn "format+ ~b")
 
141
(assert-error  (tn) (lambda () (format+ "0128b"    1)))
 
142
(assert-error  (tn) (lambda () (format+ "0128,1b"  1)))
 
143
(assert-error  (tn) (lambda () (format+ "1,0128b"  1)))
 
144
(assert-error  (tn) (lambda () (format+ "01024b"   1)))
 
145
(assert-error  (tn) (lambda () (format+ "01024,1b" 1)))
 
146
(assert-error  (tn) (lambda () (format+ "1,01024b" 1)))
 
147
(assert-equal? (tn) "-1100100" (format+ "~0b" -100))
 
148
(assert-equal? (tn) "-1010"    (format+ "~0b" -10))
 
149
(assert-equal? (tn) "-1"       (format+ "~0b" -1))
 
150
(assert-equal? (tn) "0"        (format+ "~0b" 0))
 
151
(assert-equal? (tn) "1"        (format+ "~0b" 1))
 
152
(assert-equal? (tn) "1010"     (format+ "~0b" 10))
 
153
(assert-equal? (tn) "1100100"  (format+ "~0b" 100))
 
154
 
 
155
(assert-equal? (tn) "-1100100" (format+ "~05b" -100))
 
156
(assert-equal? (tn) "-1010"    (format+ "~05b" -10))
 
157
(assert-equal? (tn) "-0001"    (format+ "~05b" -1))
 
158
(assert-equal? (tn) "00000"    (format+ "~05b" 0))
 
159
(assert-equal? (tn) "00001"    (format+ "~05b" 1))
 
160
(assert-equal? (tn) "01010"    (format+ "~05b" 10))
 
161
(assert-equal? (tn) "1100100"  (format+ "~05b" 100))
 
162
 
 
163
(assert-equal? (tn)
 
164
               "                                                                                                                            101"
 
165
               (format+ "~127b" #b101))
 
166
(assert-equal? (tn)
 
167
               "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000101"
 
168
               (format+ "~0127b" #b101))
 
169
 
 
170
(tn "format+ ~f (number)")
 
171
(assert-equal? (tn) "-100" (format+ "~0f" -100))
 
172
(assert-equal? (tn) "-10"  (format+ "~0f" -10))
 
173
(assert-equal? (tn) "-1"   (format+ "~0f" -1))
 
174
(assert-equal? (tn) "0"    (format+ "~0f" 0))
 
175
(assert-equal? (tn) "1"    (format+ "~0f" 1))
 
176
(assert-equal? (tn) "10"   (format+ "~0f" 10))
 
177
(assert-equal? (tn) "100"  (format+ "~0f" 100))
 
178
 
 
179
(assert-equal? (tn) "-100" (format "~03f" -100))
 
180
(assert-equal? (tn) "-10"  (format "~03f" -10))
 
181
(assert-equal? (tn) "-01"  (format "~03f" -1))
 
182
(assert-equal? (tn) "000"  (format "~03f" 0))
 
183
(assert-equal? (tn) "001"  (format "~03f" 1))
 
184
(assert-equal? (tn) "010"  (format "~03f" 10))
 
185
(assert-equal? (tn) "100"  (format "~03f" 100))
 
186
 
 
187
(if (symbol-bound? 'exact->inexact)
 
188
    (begin
 
189
      (assert-equal? (tn) "-100.00" (format+ "~06,02f" -100))
 
190
      (assert-equal? (tn) "-10.00"  (format+ "~06,02f" -10))
 
191
      (assert-equal? (tn) "-01.00"  (format+ "~06,02f" -1))
 
192
      (assert-equal? (tn) "000.00"  (format+ "~06,02f" 0))
 
193
      (assert-equal? (tn) "001.00"  (format+ "~06,02f" 1))
 
194
      (assert-equal? (tn) "010.00"  (format+ "~06,02f" 10))
 
195
      (assert-equal? (tn) "100.00"  (format+ "~06,02f" 100))))
 
196
 
 
197
(assert-equal? (tn)
 
198
               "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123"
 
199
               (format+ "~0127f" 123))
 
200
 
 
201
(tn "format ~h")
 
202
(define help-str
 
203
"(format+ [<port>] <format-string> [<arg>...])
 
204
  - <port> is #t, #f or an output-port
 
205
  - any escape sequence is case insensitive
 
206
 
 
207
  The format+ procedure is a SigScheme-specific superset of SRFI-48.
 
208
  Following directives accept optional width w and d digits after the decimal,
 
209
  and w accepts leading zero as zero-digit-padding specifier. All other rules
 
210
  are same as SRFI-48. See also the help message for SRFI-48.
 
211
 
 
212
SEQ        MNEMONIC       DESCRIPTION
 
213
~[w[,d]]D  [Decimal]      the arg is a number output in decimal radix
 
214
~[w[,d]]X  [heXadecimal]  the arg is a number output in hexdecimal radix
 
215
~[w[,d]]O  [Octal]        the arg is a number output in octal radix
 
216
~[w[,d]]B  [Binary]       the arg is a number output in binary radix
 
217
~[w[,d]]F  [Fixed]        the arg is a string or number
 
218
")
 
219
(assert-equal? (tn) help-str (format "~h"))
 
220
(assert-equal? (tn) help-str (format "~H"))
 
221
 
 
222
(total-report)