source: project/format-modular/tags/1.7/format-modular-test.scm @ 8363

Last change on this file since 8363 was 4403, checked in by azul, 13 years ago

Giving this egg the usual trunk/tags structure.

File size: 25.6 KB
Line 
1;;;; format-modular-test.scm
2
3;NOTE some SLIB appropriated tests fail but I think many are wrong.
4
5; Must be loaded before format so complex numbers supported
6; Will abort w/ error at 1st ~I usage otherwise
7(use numbers)
8
9; Must be loaded before format so UTF8 strings supported
10(use utf8 utf8-srfi-13 utf8-srfi-14)
11(use syntax-case)
12(import utf8)
13(import utf8-srfi-13)
14(import utf8-srfi-14)
15
16(use format-modular)
17
18(eval-when (compile)
19  (declare
20    (generic)
21    (inline)
22    (not usual-integrations
23      ; So utf8 & full-numeric-tower extensions can override.
24      ; Not all of these are 'integrated', some are for exposition.
25      ;
26      ; Numbers
27      number->string string->number
28      inexact->exact exact->inexact
29      quotient remainder
30      log
31      abs floor ceiling
32      negative? zero? positive?
33      number?
34      complex? real? integer?
35      rational?
36      + - * /
37      = < <= > >=
38      make-rectangular real-part imag-part
39      ; Characters
40      char-numeric? char-whitespace? char-alphabetic?
41      char-upcase char-downcase
42      ;; I/O
43      write-char
44      write-string
45      ; Strings
46      substring substring-index
47      string->list
48      string-ref string-length
49      string-map! string-copy string-index)
50    (no-procedure-checks-for-usual-bindings) ) )
51
52;;;
53
54(define *passed* 0)
55(define *failed* 0)
56
57(define (test expected . rest)
58        (let ([result (apply format #f rest)])
59                (if (string=? result expected)
60                        (begin
61                                (set! *passed* (add1 *passed*))
62                                (printf "Passed: (~S)~%Produce: ~S~%Expect:  ~S~%~%" rest result expected))
63                        (begin
64                                (set! *failed* (add1 *failed*))
65                                (printf "Failed: (~S)~%Produce: ~S~%Expect:  ~S~%~%" rest result expected)))))
66
67; make sure both ~A and ~a work:
68(test "hey there" "~a ~A" "hey" "there")
69
70(test "7 tries/1 win" "~D tr~:@P/~D win~:P" 7 1)
71(test "1 try/0 wins" "~D tr~:@P/~D win~:P" 1 0)
72(test "1 try/1 win" "~D tr~:@P/~D win~:P" 1 1)
73(test "2 tries/3 wins" "~D tr~:@P/~D win~:P" 2 3)
74
75(test "Results: NONE\n" "Results: ~#[NONE~;~A~;~A ~0[and~;y~] ~A~;~A, ~A and ~A~]~%")
76(test "Results: 1\n" "Results: ~#[NONE~;~A~;~A ~0[and~;y~] ~A~;~A, ~A and ~A~]~%" 1)
77(test "Results: 1 and 2\n" "Results: ~#[NONE~;~A~;~A ~0[and~;y~] ~A~;~A, ~A and ~A~]~%" 1 2)
78(test "Results: 1, 2 and 3\n" "Results: ~#[NONE~;~A~;~A ~0[and~;y~] ~A~;~A, ~A and ~A~]~%" 1 2 3)
79
80(test "Zero" "~0[Zero~;One~:;Other~]")
81(test "One" "~1[Zero~;One~:;Other~]")
82(test "Other" "~2[Zero~;One~:;Other~]")
83(test "Other" "~999[Zero~;One~:;Other~]")
84
85(test "[false]" "[~:[false~;true~]]" #f)
86(test "[true]" "[~:[false~;true~]]" 34)
87(test "[]" "[~@[true~]]" #f)
88(test "[true]" "[~@[true~]]" 39)
89
90(test "<Foo 5> 7" "~? ~D" "<~A ~D>" '("Foo" 5) 7)
91(test "<Foo 5> 7" "~? ~D" "<~A ~D>" '("Foo" 5 14) 7)
92(test "<Foo 5> 7" "~@? ~D" "<~A ~D>" "Foo" 5 7)
93;;Error: (format) 1: "superfluous arguments"
94;;when configured w/ formatter:unprocessed-arguments-error? = #t
95(test "<Foo 5> 14" "~@? ~D" "<~A ~D>" "Foo" 5 14 7)
96
97(test "The winners are: fred harry jill." "The winners are:~{ ~S~}." '(fred harry jill))
98
99(test "Pairs: <a,1> <b,2> <c,3>." "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3))
100(test "Pairs: <a,1> <b,2> <c,3>." "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3)))
101(test "Pairs: <a,1> <b,2> <c,3>." "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3)
102(test "Pairs: <a,1> <b,2> <c,3>." "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3))
103
104(test "[]" "[~{hey~}]" '())
105
106(test "Done." "Done.~^  ~D warning~:P.~^  ~D error~:P." )
107(test "Done.  3 warnings." "Done.~^  ~D warning~:P.~^  ~D error~:P." 3)
108(test "Done.  1 warning.  5 errors." "Done.~^  ~D warning~:P.~^  ~D error~:P." 1 5)
109
110(test "/hot .../hamburger/ice .../french ..." "~:{/~S~^ ...~}" '((hot dog) (hamburger) (ice cream) (french fries)))
111
112;;Error: (format) 1: "superfluous arguments"
113;;when configured w/ formatter:unprocessed-arguments-error? = #t
114(test "None" "~[None~;~:{/~S~^...~}~]" 0 '((h e) (d) (h d)))
115
116(test "/h.../d/h..." "~[None~;~:{/~S~^...~}~]" 1 '((h e) (d) (h d)))
117
118(test "TheData: 0" "~1{~:}" "TheData: ~A" '(0))
119
120;;Failed: Produce: [0][1][2][3][4] Expect: [0][1]
121;;when configured w/ formatter:iteration-bounded = #f
122(test "[0][1]" "~2{[~A]~}" '(0 1 2 3 4))
123
124(test "a \n a ^J #\\a #\\newline" "~C ~C ~:C ~:C ~@C ~@C" #\a #\newline #\a #\newline #\a #\newline)
125
126(test "XXIII MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMCCCLXXXIIII DCCCCXXIII" "~:@R ~:@R ~:@R" 23 32384 923)
127(test "MCMLXXX IV CCCXCIII MMMMMMMMMCCXXXIX" "~@R ~@R ~@R ~@R" 1980 4 393 9239)
128
129(test "one hundred twenty-eight zero two million, nine hundred thirty-eight thousand, three hundred twenty-eight nine thousand, two hundred thirty-eight two thousand, eight hundred thirty-nine thirty-eight three thousand, eight hundred twenty-eight" "~R ~R ~R ~R ~R ~R ~R" 128 0 2938328 9238 2839 38 3828)
130(test "one hundred twenty-eighth zeroth two million, nine hundred thirty-eight thousand, three hundred twenty-eighth nine thousand, two hundred thirty-eighth two thousand, eight hundred thirty-ninth thirty-eighth three thousand, eight hundred twentieth" "~:R ~:R ~:R ~:R ~:R ~:R ~:R" 128 0 2938328 9238 2839 38 3820)
131
132(test " -68." "~5,0F" -67.77)
133(test "-67.8" "~5,1F" -67.77)
134(test "1.000" "~,3F" 1)
135(test "1.0" "~F" 1)
136(test "***" "~3,3,0,'*F" 2)
137(test "1234.0" "~,,3F" 1.234)
138
139(define (foo expected x)
140  (test expected "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" x x x x x x))
141
142(foo "  3.14| 31.42|  3.14|3.1416|3.14|3.14159" 3.14159)
143(foo " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" -3.14159)
144(foo "100.00|******|100.00| 100.0|100.00|100.0" 100.0)
145(foo "1234.00|******|??????|1234.0|1234.00|1234.0" 1234.0)
146(foo "  0.01|  0.06|  0.01| 0.006|0.01|0.006" 0.006)
147
148(test "1.23243E+2" "~E" 123.243)
149(test "1.0E+0" "~E" 1)
150(test "    1.0E+0" "~10E" 1)
151(test "1.000E+0" "~,3E" 1)
152(test "1.0E-4" "~E" 0.0001)
153(test "2.3E+00001" "~,,5E" 23) ;; "23/10.0E+00001" w/ numbers
154(test "===" "~3,,,,'=E" 23)
155(test "####2.3E+1" "~10,,,,,'#E" 23)
156(test "1.0$+0" "~,,,,,,'$E" 1)
157
158(define (foo expected x)
159  (test expected "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" x x x x))
160
161(foo "  3.14E+0| 31.42$-01|+.003E+03|  3.14E+0" 3.14159)
162(foo " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0" -3.14159)
163(foo "  1.10E+3| 11.00$+02|+.001E+06|  1.10E+3" 1100.0)
164(foo "*********| 11.00$+12|+.001E+16| 1.10E+13" 1.1E13)
165
166(define (foo expected x)
167  (test expected "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" x x x x))
168
169(foo  "  3.14E-2|314.2$-04|0.314E-01|  3.14E-2" 0.0314159)
170(foo  "  3.14E+3|314.2$+01|0.314E+04|  3.14E+3" 3141.59)
171(foo  "  0.31   |0.314    |0.314    | 0.31    " 0.314159)
172(foo  "   3.1   | 3.14    | 3.14    |  3.1    " 3.14159)
173(foo  "   31.   | 31.4    | 31.4    |  31.    " 31.4159)
174(foo  "  3.14E+2| 314.    | 314.    |  3.14E+2" 314.159)
175(foo  "*********|314.0$+10|0.314E+13| 3.14E+12" 3.14E12)
176
177(test " "         "~T")
178(test "  "        "  ~T")
179(test "    "      "~4T")
180(test "     "     "  ~5,6T")
181(test "        "  "      ~4,4T")
182(test "        "  "     ~4,4T")
183(test "      "  "     ~4,3T")
184(test "    "      "~4,4@T")
185(test "      "    "~4,3@T")
186(test "         " "   ~4,3@T")
187
188;*****
189; SLIB format test
190;*****
191
192; swap the args
193(define test
194  (let ([tset test])
195    (lambda (fmtargs expected)
196      (apply tset expected fmtargs) ) ) )
197
198; any object test
199
200(test '("abc") "abc")
201(test '("~a" 10) "10")
202(test '("~a" -1.2) "-1.2")
203(test '("~a" a) "a")
204(test '("~a" #t) "#t")
205(test '("~a" #f) "#f")
206(test '("~a" "abc") "abc")
207(test '("~a" #(1 2 3)) "#(1 2 3)")
208(test '("~a" ()) "()")
209(test '("~a" (a)) "(a)")
210(test '("~a" (a b)) "(a b)")
211(test '("~a" (a (b c) d)) "(a (b c) d)")
212(test '("~a" (a . b)) "(a . b)")
213(test '("~a" (a (b c . d))) "(a (b . (c . d)))") ; this is ugly
214#; ; no internal object support
215(test `("~a" ,display) (formatter:iobj->str display #f))
216#; ; no internal object support
217(test `("~a" ,(current-input-port)) (formatter:iobj->str (current-input-port) #f))
218#; ; no internal object support
219(test `("~a" ,(current-output-port)) (formatter:iobj->str (current-output-port) #f))
220
221; # argument test
222
223(test '("~a ~a" 10 20) "10 20")
224(test '("~a abc ~a def" 10 20) "10 abc 20 def")
225
226; numerical test
227
228(test '("~d" 100) "100")
229(test '("~x" 100) "64")
230(test '("~o" 100) "144")
231(test '("~b" 100) "1100100")
232(test '("~@d" 100) "+100")
233(test '("~@d" -100) "-100")
234(test '("~@x" 100) "+64")
235(test '("~@o" 100) "+144")
236(test '("~@b" 100) "+1100100")
237(test '("~10d" 100) "       100")
238(test '("~:d" 123) "123")
239(test '("~:d" 1234) "1,234")
240(test '("~:d" 12345) "12,345")
241(test '("~:d" 123456) "123,456")
242(test '("~:d" 12345678) "12,345,678")
243(test '("~:d" -123) "-123")
244(test '("~:d" -1234) "-1,234")
245(test '("~:d" -12345) "-12,345")
246(test '("~:d" -123456) "-123,456")
247(test '("~:d" -12345678) "-12,345,678")
248(test '("~10:d" 1234) "     1,234")
249(test '("~10:d" -1234) "    -1,234")
250(test '("~10,'*d" 100) "*******100")
251(test '("~10,,'|:d" 12345678) "12|345|678")
252(test '("~10,,,2:d" 12345678) "12,34,56,78")
253(test '("~14,'*,'|,4:@d" 12345678) "****+1234|5678")
254(test '("~10r" 100) "100")
255(test '("~2r" 100) "1100100")
256(test '("~8r" 100) "144")
257(test '("~16r" 100) "64")
258(test '("~16,10,'*r" 100) "********64")
259
260; roman numeral test
261
262(test '("~@r" 4) "IV")
263(test '("~@r" 19) "XIX")
264(test '("~@r" 50) "L")
265(test '("~@r" 100) "C")
266(test '("~@r" 1000) "M")
267(test '("~@r" 99) "XCIX")
268(test '("~@r" 1994) "MCMXCIV")
269
270; old roman numeral test
271
272(test '("~:@r" 4) "IIII")
273(test '("~:@r" 5) "V")
274(test '("~:@r" 10) "X")
275(test '("~:@r" 9) "VIIII")
276
277; cardinal/ordinal English number test
278
279(test '("~r" 4) "four")
280(test '("~r" 10) "ten")
281(test '("~r" 19) "nineteen")
282(test '("~r" 1984) "one thousand, nine hundred eighty-four")
283(test '("~:r" -1984) "minus one thousand, nine hundred eighty-fourth")
284
285; character test
286
287(test '("~c" #\a) "a")
288(test '("~@c" #\a) "#\\a")
289(test `("~@c" ,(integer->char 32)) "#\\space")
290(test `("~@c" ,(integer->char 0)) "#\\nul")
291(test `("~@c" ,(integer->char 27)) "#\\esc")
292(test `("~@c" ,(integer->char 127)) "#\\del")
293(test `("~@c" ,(integer->char 128)) "#\\200")
294(test `("~@c" ,(integer->char 255)) "#\\377")
295#; ; character code unsupported
296(test '("~65c") "A")
297#; ; character code unsupported
298(test '("~7@c") "#\\bel")
299(test '("~:c" #\a) "a")
300(test `("~:c" ,(integer->char 1)) "^A")
301(test `("~:c" ,(integer->char 27)) "^[")
302#; ; character code unsupported
303(test '("~7:c") "^G")
304(test `("~:c" ,(integer->char 128)) "#\\200")
305(test `("~:c" ,(integer->char 127)) "#\\177")
306(test `("~:c" ,(integer->char 255)) "#\\377")
307
308
309; plural test
310
311(test '("test~p" 1) "test")
312(test '("test~p" 2) "tests")
313(test '("test~p" 0) "tests")
314(test '("tr~@p" 1) "try")
315(test '("tr~@p" 2) "tries")
316(test '("tr~@p" 0) "tries")
317(test '("~a test~:p" 10) "10 tests")
318(test '("~a test~:p" 1) "1 test")
319
320; tilde test
321
322(test '("~~~~") "~~")
323(test '("~3~") "~~~")
324
325; whitespace character test
326
327(test '("~%") "
328")
329(test '("~3%") "
330
331
332")
333(test '("~&") "")
334(test '("abc~&") "abc
335")
336(test '("abc~&def") "abc
337def")
338(test '("~&") "
339")
340(test '("~3&") "
341
342")
343(test '("abc~3&") "abc
344
345
346")
347#; ; SLIB specific
348(test '("~|") (string slib:form-feed))
349(test '("~|") (string #\page))
350(test '("~_~_~_") "   ")
351(test '("~3_") "   ")
352#; ; SLIB specific
353(test '("~/") (string slib:tab))
354#; ; SLIB specific
355(test '("~3/") (make-string 3 slib:tab))
356(test '("~/") (string #\tab))
357(test '("~3/") (make-string 3 #\tab))
358
359; tabulate test
360
361(test '("~0&~3t") "   ")
362(test '("~0&~10t") "          ")
363(test '("~10t") "")
364(test '("~0&1234567890~,8tABC")  "1234567890       ABC")
365(test '("~0&1234567890~0,8tABC") "1234567890      ABC")
366(test '("~0&1234567890~1,8tABC") "1234567890       ABC")
367(test '("~0&1234567890~2,8tABC") "1234567890ABC")
368(test '("~0&1234567890~3,8tABC") "1234567890 ABC")
369(test '("~0&1234567890~4,8tABC") "1234567890  ABC")
370(test '("~0&1234567890~5,8tABC") "1234567890   ABC")
371(test '("~0&1234567890~6,8tABC") "1234567890    ABC")
372(test '("~0&1234567890~7,8tABC") "1234567890     ABC")
373(test '("~0&1234567890~8,8tABC") "1234567890      ABC")
374(test '("~0&1234567890~9,8tABC") "1234567890       ABC")
375(test '("~0&1234567890~10,8tABC") "1234567890ABC")
376(test '("~0&1234567890~11,8tABC") "1234567890 ABC")
377(test '("~0&12345~,8tABCDE~,8tXYZ") "12345    ABCDE   XYZ")
378(test '("~,8t+++~,8t===") "     +++     ===")
379(test '("~0&ABC~,8,'.tDEF") "ABC......DEF")
380(test '("~0&~3,8@tABC") "        ABC")
381(test '("~0&1234~3,8@tABC") "1234    ABC")
382(test '("~0&12~3,8@tABC~3,8@tDEF") "12      ABC     DEF")
383
384; indirection test
385
386(test '("~a ~? ~a" 10 "~a ~a" (20 30) 40) "10 20 30 40")
387(test '("~a ~@? ~a" 10 "~a ~a" 20 30 40) "10 20 30 40")
388
389; field test
390
391(test '("~10a" "abc") "abc       ")
392(test '("~10@a" "abc") "       abc")
393(test '("~10a" "0123456789abc") "0123456789abc")
394(test '("~10@a" "0123456789abc") "0123456789abc")
395
396; pad character test
397
398(test '("~10,,,'*a" "abc") "abc*******")
399(test '("~10,,,'Xa" "abc") "abcXXXXXXX")
400;;(test '("~10,,,42a" "abc") "abc*******")
401(test '("~10,,,'*@a" "abc") "*******abc")
402(test '("~10,,3,'*a" "abc") "abc*******")
403(test '("~10,,3,'*a" "0123456789abc") "0123456789abc***") ; min. padchar length
404(test '("~10,,3,'*@a" "0123456789abc") "***0123456789abc")
405
406; colinc, minpad padding test
407
408(test '("~10,8,0,'*a" 123)  "123********")
409(test '("~10,9,0,'*a" 123)  "123*********")
410(test '("~10,10,0,'*a" 123) "123**********")
411(test '("~10,11,0,'*a" 123) "123***********")
412(test '("~8,1,0,'*a" 123) "123*****")
413(test '("~8,2,0,'*a" 123) "123******")
414(test '("~8,3,0,'*a" 123) "123******")
415(test '("~8,4,0,'*a" 123) "123********")
416(test '("~8,5,0,'*a" 123) "123*****")
417(test '("~8,1,3,'*a" 123) "123*****")
418(test '("~8,1,5,'*a" 123) "123*****")
419(test '("~8,1,6,'*a" 123) "123******")
420(test '("~8,1,9,'*a" 123) "123*********")
421
422; slashify test
423
424(test '("~s" "abc") "\"abc\"")
425(test '("~s" "abc \\ abc") "\"abc \\\\ abc\"")
426(test '("~a" "abc \\ abc") "abc \\ abc")
427(test '("~s" "abc \" abc") "\"abc \\\" abc\"")
428(test '("~a" "abc \" abc") "abc \" abc")
429(test '("~s" #\space) "#\\space")
430(test '("~s" #\newline) "#\\newline")
431#; ; SLIB specific
432(test `("~s" ,slib:tab) "#\\ht")
433(test '("~s" #\a) "#\\a")
434(test '("~a" (a "b" c)) "(a \"b\" c)")
435
436; flush output (can't test it here really)
437
438(test '("abc ~! xyz") "abc  xyz")
439
440; string case conversion
441
442(test '("~a ~(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc hello world xyz")
443(test '("~a ~:(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc Hello World xyz")
444(test '("~a ~@(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc Hello world xyz")
445(test '("~a ~:@(~a~) ~a" "abc" "hello world" "xyz") "abc HELLO WORLD xyz")
446(test '("~:@(~a~)" (a b c)) "(A B C)")
447(test '("~:@(~x~)" 255) "FF")
448(test '("~:@(~p~)" 2) "S")
449#; ; no internal object support
450(test `("~:@(~a~)" ,display) (string-upcase (formatter:iobj->str display #f)))
451(test '("~:(~a ~a ~a~) ~a" "abc" "xyz" "123" "world") "Abc Xyz 123 world")
452
453; variable parameter
454
455(test '("~va" 10 "abc") "abc       ")
456#; ; character code unsupported
457(test '("~v,,,va" 10 42 "abc") "abc*******")
458(test '("~v,,,va" 10 #\* "abc") "abc*******")
459
460; number of remaining arguments as parameter
461
462(test '("~#,,,'*@a ~a ~a ~a" 1 1 1 1) "***1 1 1 1")
463
464; argument jumping
465
466(test '("~a ~* ~a" 10 20 30) "10  30")
467(test '("~a ~2* ~a" 10 20 30 40) "10  40")
468(test '("~a ~:* ~a" 10) "10  10")
469(test '("~a ~a ~2:* ~a ~a" 10 20) "10 20  10 20")
470(test '("~a ~a ~@* ~a ~a" 10 20) "10 20  10 20")
471(test '("~a ~a ~4@* ~a ~a" 10 20 30 40 50 60) "10 20  50 60")
472
473; conditionals
474
475(test '("~[abc~;xyz~]" 0) "abc")
476(test '("~[abc~;xyz~]" 1) "xyz")
477(test '("~[abc~;xyz~:;456~]" 99) "456")
478(test '("~0[abc~;xyz~:;456~]") "abc")
479(test '("~1[abc~;xyz~:;456~] ~a" 100) "xyz 100")
480(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]") "no arg")
481(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10) "10")
482(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10 20) "10 and 20")
483(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10 20 30) "10, 20 and 30")
484(test '("~:[hello~;world~] ~a" #t 10) "world 10")
485(test '("~:[hello~;world~] ~a" #f 10) "hello 10")
486(test '("~@[~a tests~]" #f) "")
487(test '("~@[~a tests~]" 10) "10 tests")
488(test '("~@[~a test~:p~] ~a" 10 done) "10 tests done")
489(test '("~@[~a test~:p~] ~a" 1 done) "1 test done")
490(test '("~@[~a test~:p~] ~a" 0 done) "0 tests done")
491(test '("~@[~a test~:p~] ~a" #f done) " done")
492(test '("~@[ level = ~d~]~@[ length = ~d~]" #f 5) " length = 5")
493(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 0) "abc")   ; nested conditionals (irrghh)
494(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 2) "xyz")
495(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 1 2) "6")
496
497; iteration
498
499(test '("~{ ~a ~}" (a b c)) " a  b  c ")
500(test '("~{ ~a ~}" ()) "")
501(test '("~{ ~a ~5,,,'*a~}" (a b c d)) " a b**** c d****")
502(test '("~{ ~a,~a ~}" (a 1 b 2 c 3)) " a,1  b,2  c,3 ")
503(test '("~2{ ~a,~a ~}" (a 1 b 2 c 3)) " a,1  b,2 ")
504(test '("~3{~a ~} ~a" (a b c d e) 100) "a b c  100")
505(test '("~0{~a ~} ~a" (a b c d e) 100) " 100")
506(test '("~:{ ~a,~a ~}" ((a b) (c d e f) (g h))) " a,b  c,d  g,h ")
507(test '("~2:{ ~a,~a ~}" ((a b) (c d e f) (g h))) " a,b  c,d ")
508(test '("~@{ ~a,~a ~}" a 1 b 2 c 3) " a,1  b,2  c,3 ")
509(test '("~2@{ ~a,~a ~} <~a|~a>" a 1 b 2 c 3) " a,1  b,2  <c|3>")
510(test '("~:@{ ~a,~a ~}" (a 1) (b 2) (c 3)) " a,1  b,2  c,3 ")
511(test '("~2:@{ ~a,~a ~} ~a" (a 1) (b 2) (c 3)) " a,1  b,2  (c 3)")
512(test '("~{~}" "<~a,~a>" (a 1 b 2 c 3)) "<a,1><b,2><c,3>")
513(test '("~{ ~a ~{<~a>~}~} ~a" (a (1 2) b (3 4)) 10) " a <1><2> b <3><4> 10")
514(let ((nums (let iter ((ns '()) (l 0))
515              (if (> l 105) (reverse ns) (iter (cons l ns) (+ l 1))))))
516  ;; Test default, only 100 items formatted out:
517  (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums))
518        "0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100")
519  ;; Test control of number of items formatted out:
520  (set! *formatter:max-iterations* 90)
521  (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums))
522        "0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90")
523  ;; Test control of imposing bound on number of items formatted out:
524  (set! *formatter:iteration-bounded* #f)
525  (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums))
526        "0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105")
527  ;; Restore defaults:
528  (set! *formatter:iteration-bounded* #t)
529  (set! *formatter:max-iterations* 100)
530  )
531
532; up and out
533
534(test '("abc ~^ xyz") "abc ")
535(test '("~@(abc ~^ xyz~) ~a" 10) "ABC  xyz 10")
536(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p.") "done. ")
537(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p." 10) "done.  10 warnings. ")
538(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p." 10 1)
539      "done.  10 warnings.  1 error.")
540(test '("~{ ~a ~^<~a>~} ~a" (a b c d e f) 10) " a <b> c <d> e <f> 10")
541(test '("~{ ~a ~^<~a>~} ~a" (a b c d e) 10) " a <b> c <d> e  10")
542(test '("abc~0^ xyz") "abc")
543(test '("abc~9^ xyz") "abc xyz")
544(test '("abc~7,4^ xyz") "abc xyz")
545(test '("abc~7,7^ xyz") "abc")
546(test '("abc~3,7,9^ xyz") "abc")
547(test '("abc~8,7,9^ xyz") "abc xyz")
548(test '("abc~3,7,5^ xyz") "abc xyz")
549
550#|
551; complexity tests (oh my god, I hardly understand them myself (see CL std))
552
553(define fmt "Items:~#[ none~; ~a~; ~a and ~a~:;~@{~#[~; and~] ~a~^,~}~].")
554
555(test `(,fmt ) "Items: none.")
556(test `(,fmt foo) "Items: foo.")
557(test `(,fmt foo bar) "Items: foo and bar.")
558(test `(,fmt foo bar baz) "Items: foo, bar, and baz.")
559(test `(,fmt foo bar baz zok) "Items: foo, bar, baz, and zok.")
560|#
561
562; fixed floating points
563
564(test '("~6,2f" 3.14159) "  3.14")
565(test '("~6,1f" 3.14159) "   3.1")
566(test '("~6,0f" 3.14159) "    3.")
567(test '("~5,1f" 0) "  0.0")
568(test '("~10,7f" 3.14159) " 3.1415900")
569(test '("~10,7f" -3.14159) "-3.1415900")
570(test '("~10,7@f" 3.14159) "+3.1415900")
571(test '("~6,3f" 0.0) " 0.000")
572(test '("~6,4f" 0.007) "0.0070")
573(test '("~6,3f" 0.007) " 0.007")
574(test '("~6,2f" 0.007) "  0.01")
575(test '("~3,2f" 0.007) ".01")
576(test '("~3,2f" -0.007) "-.01")
577(test '("~6,2,,,'*f" 3.14159) "**3.14")
578(test '("~6,3,,'?f" 12345.56789) "??????")
579(test '("~6,3f" 12345.6789) "12345.679")
580(test '("~,3f" 12345.6789) "12345.679")
581(test '("~,3f" 9.9999) "10.000")
582(test '("~6f" 23.4) "  23.4")
583(test '("~6f" 1234.5) "1234.5")
584(test '("~6f" 12345678) "12345678.0")
585(test '("~6,,,'?f" 12345678) "??????")
586(test '("~6f" 123.56789) "123.57")
587(test '("~6f" 123.0) " 123.0")
588(test '("~6f" -123.0) "-123.0")
589(test '("~6f" 0.0) "   0.0")
590(test '("~3f" 3.141) "3.1")
591(test '("~2f" 3.141) "3.")
592(test '("~1f" 3.141) "3.141")
593(test '("~f" 123.56789) "123.56789")
594(test '("~f" -314.0) "-314.0")
595(test '("~f" 1e4) "10000.0")
596(test '("~f" -1.23e10) "-12300000000.0")
597(test '("~f" 1e-4) "0.0001")
598(test '("~f" -1.23e-10) "-0.000000000123")
599(test '("~@f" 314.0) "+314.0")
600(test '("~,,3f" 0.123456) "123.456")
601(test '("~,,-3f" -123.456) "-0.123456")
602(test '("~5,,3f" 0.123456) "123.5")
603
604; exponent floating points
605
606(test '("~e" 3.14159) "3.14159E+0")
607(test '("~e" 0.00001234) "1.234E-5")
608(test '("~,,,0e" 0.00001234) "0.1234E-4")
609(test '("~,3e" 3.14159) "3.142E+0")
610(test '("~,3@e" 3.14159) "+3.142E+0")
611(test '("~,3@e" 0.0) "+0.000E+0")
612(test '("~,0e" 3.141) "3.E+0")
613(test '("~,3,,0e" 3.14159) "0.314E+1")
614(test '("~,5,3,-2e" 3.14159) "0.00314E+003")
615(test '("~,5,3,-5e" -3.14159) "-0.00000E+006")
616(test '("~,5,2,2e" 3.14159) "31.4159E-01")
617(test '("~,5,2,,,,'ee" 0.0) "0.00000e+00")
618(test '("~12,3e" -3.141) "   -3.141E+0")
619(test '("~12,3,,,,'#e" -3.141) "###-3.141E+0")
620(test '("~10,2e" -1.236e-4) "  -1.24E-4")
621(test '("~5,3e" -3.141) "-3.141E+0")
622(test '("~5,3,,,'*e" -3.141) "*****")
623(test '("~3e" 3.14159) "3.14159E+0")
624(test '("~4e" 3.14159) "3.14159E+0")
625(test '("~5e" 3.14159) "3.E+0")
626(test '("~5,,,,'*e" 3.14159) "3.E+0")
627(test '("~6e" 3.14159) "3.1E+0")
628(test '("~7e" 3.14159) "3.14E+0")
629(test '("~7e" -3.14159) "-3.1E+0")
630(test '("~8e" 3.14159) "3.142E+0")
631(test '("~9e" 3.14159) "3.1416E+0")
632(test '("~9,,,,,,'ee" 3.14159) "3.1416e+0")
633(test '("~10e" 3.14159) "3.14159E+0")
634(test '("~11e" 3.14159) " 3.14159E+0")
635(test '("~12e" 3.14159) "  3.14159E+0")
636(test '("~13,6,2,-5e" 3.14159) " 0.000003E+06")
637(test '("~13,6,2,-4e" 3.14159) " 0.000031E+05")
638(test '("~13,6,2,-3e" 3.14159) " 0.000314E+04")
639(test '("~13,6,2,-2e" 3.14159) " 0.003142E+03")
640(test '("~13,6,2,-1e" 3.14159) " 0.031416E+02")
641(test '("~13,6,2,0e" 3.14159)  " 0.314159E+01")
642(test '("~13,6,2,1e" 3.14159)  " 3.141590E+00")
643(test '("~13,6,2,2e" 3.14159)  " 31.41590E-01")
644(test '("~13,6,2,3e" 3.14159)  " 314.1590E-02")
645(test '("~13,6,2,4e" 3.14159)  " 3141.590E-03")
646(test '("~13,6,2,5e" 3.14159)  " 31415.90E-04")
647(test '("~13,6,2,6e" 3.14159)  " 314159.0E-05")
648(test '("~13,6,2,7e" 3.14159)  " 3141590.E-06")
649(test '("~13,6,2,8e" 3.14159)  "31415900.E-07")
650(test '("~7,3,,-2e" 0.001) ".001E+0")
651(test '("~8,3,,-2@e" 0.001) "+.001E+0")
652(test '("~8,3,,-2@e" -0.001) "-.001E+0")
653(test '("~8,3,,-2e" 0.001) "0.001E+0")
654(test '("~7,,,-2e" 0.001) "0.00E+0")
655(test '("~12,3,1e" 3.14159e12) "   3.142E+12")
656(test '("~12,3,1,,'*e" 3.14159e12) "************")
657(test '("~5,3,1e" 3.14159e12) "3.142E+12")
658
659; general floating point (this test is from Steele's CL book)
660
661(test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
662  0.0314159 0.0314159 0.0314159 0.0314159)
663"  3.14E-2|314.2$-04|0.314E-01|  3.14E-2")
664(test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
665  0.314159 0.314159 0.314159 0.314159)
666"  0.31   |0.314    |0.314    | 0.31    ")
667(test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
668  3.14159 3.14159 3.14159 3.14159)
669"   3.1   | 3.14    | 3.14    |  3.1    ")
670(test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
671  31.4159 31.4159 31.4159 31.4159)
672"   31.   | 31.4    | 31.4    |  31.    ")
673(test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
674  314.159 314.159 314.159 314.159)
675"  3.14E+2| 314.    | 314.    |  3.14E+2")
676(test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
677  3141.59 3141.59 3141.59 3141.59)
678"  3.14E+3|314.2$+01|0.314E+04|  3.14E+3")
679(test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
680  3.14E12 3.14E12 3.14E12 3.14E12)
681"*********|314.0$+10|0.314E+13| 3.14E+12")
682(test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
683  3.14E120 3.14E120 3.14E120 3.14E120)
684"*********|?????????|%%%%%%%%%|3.14E+120")
685
686(test '("~g" 0.0) "0.0    ")            ; further ~g tests
687(test '("~g" 0.1) "0.1    ")
688(test '("~g" 0.01) "1.0E-2")
689(test '("~g" 123.456) "123.456    ")
690(test '("~g" 123456.7) "123456.7    ")
691(test '("~g" 123456.78) "123456.78    ")
692(test '("~g" 0.9282) "0.9282    ")
693(test '("~g" 0.09282) "9.282E-2")
694(test '("~g" 1) "1.0    ")
695(test '("~g" 12) "12.0    ")
696
697; dollar floating point
698
699(test '("~$" 1.23) "1.23")
700(test '("~$" 1.2) "1.20")
701(test '("~$" 0.0) "0.00")
702(test '("~$" 9.999) "10.00")
703(test '("~3$" 9.9999) "10.000")
704(test '("~,4$" 3.2) "0003.20")
705(test '("~,4$" 10000.2) "10000.20")
706(test '("~,4,10$" 3.2) "   0003.20")
707(test '("~,4,10@$" 3.2) "  +0003.20")
708(test '("~,4,10:@$" 3.2) "+  0003.20")
709(test '("~,4,10:$" -3.2) "-  0003.20")
710(test '("~,4,10$" -3.2) "  -0003.20")
711(test '("~,,10@$" 3.2) "     +3.20")
712(test '("~,,10:@$" 3.2) "+     3.20")
713(test '("~,,10:@$" -3.2) "-     3.20")
714(test '("~,,10,'_@$" 3.2) "_____+3.20")
715(test '("~,,4$" 1234.4) "1234.40")
716
717; complex numbers
718
719(test '("~i" 3.0) "3.0+0.0i")
720(test '("~,3i" 3.0) "3.000+0.000i")
721(test `("~7,2i" ,(string->number "3.0+5.0i")) "   3.00  +5.00i")
722(test `("~7,2,1i" ,(string->number "3.0+5.0i")) "  30.00 +50.00i")
723(test `("~7,2@i" ,(string->number "3.0+5.0i")) "  +3.00  +5.00i")
724(test `("~7,2,,,'*@i" ,(string->number "3.0+5.0i")) "**+3.00**+5.00i")
725
726;;;
727
728(printf "Passed: ~S Failed: ~S~%" *passed* *failed*)
Note: See TracBrowser for help on using the repository browser.