1;;  Filename : test-srfi28.scm
2;;  About    : unit test for SRFI-28
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 r3166 (new repository)
35
36(require-extension (unittest))
37
38(require-extension (srfi 28))
39
40(if (not (provided? "srfi-28"))
41    (test-skip "SRFI-28 is not enabled"))
42
43(define tn test-name)
44
45(tn "format invalid form")
46(assert-error  (tn) (lambda () (format)))
47(assert-error  (tn) (lambda () (format #f)))
48(assert-error  (tn) (lambda () (format #\a)))
49(assert-error  (tn) (lambda () (format "~")))
50(assert-error  (tn) (lambda () (format "a~")))
51(assert-error  (tn) (lambda () (format "a" "a")))
52
53(tn "format unknown directives")
54(assert-error  (tn) (lambda () (format "~z")))
55(assert-error  (tn) (lambda () (format "~Z")))
56(assert-error  (tn) (lambda () (format "~'")))
57(assert-error  (tn) (lambda () (format "~$")))
58
59(tn "format SRFI-48 directives")
60(if (not (provided? "srfi-48"))
61    (begin
62      (assert-error  (tn) (lambda () (format "~w" 0)))
63      (assert-error  (tn) (lambda () (format "~d" 0)))
64      (assert-error  (tn) (lambda () (format "~x" 0)))
65      (assert-error  (tn) (lambda () (format "~o" 0)))
66      (assert-error  (tn) (lambda () (format "~b" 0)))
67      (assert-error  (tn) (lambda () (format "~c" #\a)))
68      (assert-error  (tn) (lambda () (format "~f" 0)))
69      (assert-error  (tn) (lambda () (format "~2f" 0)))
70      (assert-error  (tn) (lambda () (format "~2,3f" 0)))
71      (assert-error  (tn) (lambda () (format "~?" "~s" '(0))))
72      (assert-error  (tn) (lambda () (format "~k" "~s" '(0))))
73      (assert-error  (tn) (lambda () (format "~y" '(0))))
74
75      (assert-error  (tn) (lambda () (format "~t")))
76      (assert-error  (tn) (lambda () (format "~_")))
77      (assert-error  (tn) (lambda () (format "~&")))
78      (assert-error  (tn) (lambda () (format "~h")))))
79
80(tn "format no directive")
81(assert-error  (tn) (lambda () (format "" 0)))
82(assert-equal? (tn)
83               ""
84               (format ""))
85(assert-equal? (tn)
86               "aBc"
87               (format "aBc"))
88
89(tn "format ~a")
90(assert-error  (tn) (lambda () (format "~a")))
91(assert-error  (tn) (lambda () (format "~a" 0 1)))
92(assert-error  (tn) (lambda () (format "~1a" 1)))
93(assert-equal? (tn)
94               (if (and (provided? "sigscheme")
95                        (provided? "siod-bugs"))
96                   "()"
97                   "#f")
98               (format "~a" #f))
99(assert-equal? (tn)
100               "#t"
101               (format "~a" #t))
102(assert-equal? (tn)
103               "123"
104               (format "~a" 123))
105(assert-equal? (tn)
106               "a"
107               (format "~a" #\a))
108(assert-equal? (tn)
109               "aBc"
110               (format "~a" "aBc"))
111(assert-equal? (tn)
112               "(#t 123 a aBc (0))"
113               (format "~a" '(#t 123 #\a "aBc" (0))))
114
115(tn "format ~A")
116(assert-error  (tn) (lambda () (format "~A")))
117(assert-error  (tn) (lambda () (format "~A" 0 1)))
118(assert-error  (tn) (lambda () (format "~1A" 1)))
119(assert-equal? (tn)
120               (if (and (provided? "sigscheme")
121                        (provided? "siod-bugs"))
122                   "()"
123                   "#f")
124               (format "~A" #f))
125(assert-equal? (tn)
126               "#t"
127               (format "~A" #t))
128(assert-equal? (tn)
129               "123"
130               (format "~A" 123))
131(assert-equal? (tn)
132               "a"
133               (format "~A" #\a))
134(assert-equal? (tn)
135               "aBc"
136               (format "~A" "aBc"))
137(assert-equal? (tn)
138               "(#t 123 a aBc (0))"
139               (format "~A" '(#t 123 #\a "aBc" (0))))
140
141(tn "format ~s")
142(assert-error  (tn) (lambda () (format "~s")))
143(assert-error  (tn) (lambda () (format "~s" 0 1)))
144(assert-error  (tn) (lambda () (format "~1s" 1)))
145(assert-equal? (tn)
146               (if (and (provided? "sigscheme")
147                        (provided? "siod-bugs"))
148                   "()"
149                   "#f")
150               (format "~s" #f))
151(assert-equal? (tn)
152               "#t"
153               (format "~s" #t))
154(assert-equal? (tn)
155               "123"
156               (format "~s" 123))
157(assert-equal? (tn)
158               "#\\a"
159               (format "~s" #\a))
160(assert-equal? (tn)
161               "\"aBc\""
162               (format "~s" "aBc"))
163(assert-equal? (tn)
164               "(#t 123 #\\a \"aBc\" (0))"
165               (format "~s" '(#t 123 #\a "aBc" (0))))
166
167(tn "format ~S")
168(assert-error  (tn) (lambda () (format "~S")))
169(assert-error  (tn) (lambda () (format "~S" 0 1)))
170(assert-error  (tn) (lambda () (format "~1S" 1)))
171(assert-equal? (tn)
172               (if (and (provided? "sigscheme")
173                        (provided? "siod-bugs"))
174                   "()"
175                   "#f")
176               (format "~S" #f))
177(assert-equal? (tn)
178               "#t"
179               (format "~S" #t))
180(assert-equal? (tn)
181               "123"
182               (format "~S" 123))
183(assert-equal? (tn)
184               "#\\a"
185               (format "~S" #\a))
186(assert-equal? (tn)
187               "\"aBc\""
188               (format "~S" "aBc"))
189(assert-equal? (tn)
190               "(#t 123 #\\a \"aBc\" (0))"
191               (format "~S" '(#t 123 #\a "aBc" (0))))
192
193(tn "format ~%")
194(assert-error  (tn) (lambda () (format "~%" 0)))
195(assert-equal? (tn)
196               "\n"
197               (format "~%"))
198
199(tn "format ~~")
200(assert-error  (tn) (lambda () (format "~~" 0)))
201(assert-equal? (tn)
202               "~"
203               (format "~~"))
204
205(tn "format mixed directives")
206(assert-equal? (tn)
207               "~\n"
208               (format "~~~%"))
209(assert-equal? (tn)
210               "slashified: #\\a\nany: a\n"
211               (format "slashified: ~s~%any: ~a~%" #\a #\a))
212
213(if (not (provided? "srfi-48"))
214    (total-report))
215