This repository has been archived by the owner on May 3, 2024. It is now read-only.
forked from richhickey/clojure-contrib
/
test_cl_format.clj
691 lines (584 loc) · 30.9 KB
/
test_cl_format.clj
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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
;;; cl_format.clj -- part of the pretty printer for Clojure
;; by Tom Faulhaber
;; April 3, 2009
; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file epl-v10.html at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.
;; This test set tests the basic cl-format functionality
(ns clojure.contrib.pprint.test-cl-format
(:refer-clojure :exclude [format])
(:use [clojure.test :only (deftest are run-tests)]
clojure.contrib.pprint.test-helper
clojure.contrib.pprint))
(def format cl-format)
;; TODO tests for ~A, ~D, etc.
;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding
(simple-tests d-tests
(cl-format nil "~D" 0) "0"
(cl-format nil "~D" 2e6) "2000000"
(cl-format nil "~D" 2000000) "2000000"
(cl-format nil "~:D" 2000000) "2,000,000"
(cl-format nil "~D" 1/2) "1/2"
(cl-format nil "~D" 'fred) "fred"
)
(simple-tests base-tests
(cl-format nil "~{~2r~^ ~}~%" (range 10))
"0 1 10 11 100 101 110 111 1000 1001\n"
(with-out-str
(dotimes [i 35]
(binding [*print-base* (+ i 2)] ;print the decimal number 40
(write 40) ;in each base from 2 to 36
(if (zero? (mod i 10)) (prn) (cl-format true " ")))))
"101000
1111 220 130 104 55 50 44 40 37 34
31 2c 2a 28 26 24 22 20 1j 1i
1h 1g 1f 1e 1d 1c 1b 1a 19 18
17 16 15 14 "
(with-out-str
(doseq [pb [2 3 8 10 16]]
(binding [*print-radix* true ;print the integer 10 and
*print-base* pb] ;the ratio 1/10 in bases 2,
(cl-format true "~&~S ~S~%" 10 1/10)))) ;3, 8, 10, 16
"#b1010 #b1/1010
#3r101 #3r1/101
#o12 #o1/12
10. #10r1/10
#xa #x1/a
")
(simple-tests cardinal-tests
(cl-format nil "~R" 0) "zero"
(cl-format nil "~R" 4) "four"
(cl-format nil "~R" 15) "fifteen"
(cl-format nil "~R" -15) "minus fifteen"
(cl-format nil "~R" 25) "twenty-five"
(cl-format nil "~R" 20) "twenty"
(cl-format nil "~R" 200) "two hundred"
(cl-format nil "~R" 203) "two hundred three"
(cl-format nil "~R" 44879032)
"forty-four million, eight hundred seventy-nine thousand, thirty-two"
(cl-format nil "~R" -44879032)
"minus forty-four million, eight hundred seventy-nine thousand, thirty-two"
(cl-format nil "~R = ~:*~:D" 44000032)
"forty-four million, thirty-two = 44,000,032"
(cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094)
"four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-four = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094"
(cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475)
"448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475 = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475"
(cl-format nil "~R = ~:*~:D" 2e6)
"two million = 2,000,000"
(cl-format nil "~R = ~:*~:D" 200000200000)
"two hundred billion, two hundred thousand = 200,000,200,000")
(simple-tests ordinal-tests
(cl-format nil "~:R" 0) "zeroth"
(cl-format nil "~:R" 4) "fourth"
(cl-format nil "~:R" 15) "fifteenth"
(cl-format nil "~:R" -15) "minus fifteenth"
(cl-format nil "~:R" 25) "twenty-fifth"
(cl-format nil "~:R" 20) "twentieth"
(cl-format nil "~:R" 200) "two hundredth"
(cl-format nil "~:R" 203) "two hundred third"
(cl-format nil "~:R" 44879032)
"forty-four million, eight hundred seventy-nine thousand, thirty-second"
(cl-format nil "~:R" -44879032)
"minus forty-four million, eight hundred seventy-nine thousand, thirty-second"
(cl-format nil "~:R = ~:*~:D" 44000032)
"forty-four million, thirty-second = 44,000,032"
(cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094)
"four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-fourth = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094"
(cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475)
"448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475th = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475"
(cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471)
"448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471st = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471"
(cl-format nil "~:R = ~:*~:D" 2e6)
"two millionth = 2,000,000")
(simple-tests ordinal1-tests
(cl-format nil "~:R" 1) "first"
(cl-format nil "~:R" 11) "eleventh"
(cl-format nil "~:R" 21) "twenty-first"
(cl-format nil "~:R" 20) "twentieth"
(cl-format nil "~:R" 220) "two hundred twentieth"
(cl-format nil "~:R" 200) "two hundredth"
(cl-format nil "~:R" 999) "nine hundred ninety-ninth"
)
(simple-tests roman-tests
(cl-format nil "~@R" 3) "III"
(cl-format nil "~@R" 4) "IV"
(cl-format nil "~@R" 9) "IX"
(cl-format nil "~@R" 29) "XXIX"
(cl-format nil "~@R" 429) "CDXXIX"
(cl-format nil "~@:R" 429) "CCCCXXVIIII"
(cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII"
(cl-format nil "~@R" 3429) "MMMCDXXIX"
(cl-format nil "~@R" 3479) "MMMCDLXXIX"
(cl-format nil "~@R" 3409) "MMMCDIX"
(cl-format nil "~@R" 300) "CCC"
(cl-format nil "~@R ~D" 300 20) "CCC 20"
(cl-format nil "~@R" 5000) "5,000"
(cl-format nil "~@R ~D" 5000 20) "5,000 20"
(cl-format nil "~@R" "the quick") "the quick")
(simple-tests c-tests
(cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n"
(cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n"
(cl-format nil "~@C~%" \m) "\\m\n"
(cl-format nil "~@C~%" (char 222)) "\\Þ\n"
(cl-format nil "~@C~%" (char 8)) "\\backspace\n"
(cl-format nil "~@C~%" (char 3)) "\\\n")
(simple-tests e-tests
(cl-format nil "*~E*" 0.0) "*0.0E+0*"
(cl-format nil "*~6E*" 0.0) "*0.0E+0*"
(cl-format nil "*~6,0E*" 0.0) "* 0.E+0*"
(cl-format nil "*~7,2E*" 0.0) "*0.00E+0*"
(cl-format nil "*~5E*" 0.0) "*0.E+0*"
(cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*"
(cl-format nil "*~10,2E*" 9.99999) "* 1.00E+1*"
(cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*"
(cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*"
(cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*"
)
(simple-tests $-tests
(cl-format nil "~$" 22.3) "22.30"
(cl-format nil "~$" 22.375) "22.38"
(cl-format nil "~3,5$" 22.375) "00022.375"
(cl-format nil "~3,5,8$" 22.375) "00022.375"
(cl-format nil "~3,5,10$" 22.375) " 00022.375"
(cl-format nil "~3,5,14@$" 22.375) " +00022.375"
(cl-format nil "~3,5,14@$" 22.375) " +00022.375"
(cl-format nil "~3,5,14@:$" 22.375) "+ 00022.375"
(cl-format nil "~3,,14@:$" 0.375) "+ 0.375"
(cl-format nil "~1,1$" -12.0) "-12.0"
(cl-format nil "~1,1$" 12.0) "12.0"
(cl-format nil "~1,1$" 12.0) "12.0"
(cl-format nil "~1,1@$" 12.0) "+12.0"
(cl-format nil "~1,1,8,' @:$" 12.0) "+ 12.0"
(cl-format nil "~1,1,8,' @$" 12.0) " +12.0"
(cl-format nil "~1,1,8,' :$" 12.0) " 12.0"
(cl-format nil "~1,1,8,' $" 12.0) " 12.0"
(cl-format nil "~1,1,8,' @:$" -12.0) "- 12.0"
(cl-format nil "~1,1,8,' @$" -12.0) " -12.0"
(cl-format nil "~1,1,8,' :$" -12.0) "- 12.0"
(cl-format nil "~1,1,8,' $" -12.0) " -12.0"
(cl-format nil "~1,1$" 0.001) "0.0"
(cl-format nil "~2,1$" 0.001) "0.00"
(cl-format nil "~1,1,6$" 0.001) " 0.0"
(cl-format nil "~1,1,6$" 0.0015) " 0.0"
(cl-format nil "~2,1,6$" 0.005) " 0.01"
(cl-format nil "~2,1,6$" 0.01) " 0.01"
(cl-format nil "~$" 0.099) "0.10"
(cl-format nil "~1$" 0.099) "0.1"
(cl-format nil "~1$" 0.1) "0.1"
(cl-format nil "~1$" 0.99) "1.0"
(cl-format nil "~1$" -0.99) "-1.0")
(simple-tests f-tests
(cl-format nil "~,1f" -12.0) "-12.0"
(cl-format nil "~,0f" 9.4) "9."
(cl-format nil "~,0f" 9.5) "10."
(cl-format nil "~,0f" -0.99) "-1."
(cl-format nil "~,1f" -0.99) "-1.0"
(cl-format nil "~,2f" -0.99) "-0.99"
(cl-format nil "~,3f" -0.99) "-0.990"
(cl-format nil "~,0f" 0.99) "1."
(cl-format nil "~,1f" 0.99) "1.0"
(cl-format nil "~,2f" 0.99) "0.99"
(cl-format nil "~,3f" 0.99) "0.990"
(cl-format nil "~f" -1) "-1.0"
(cl-format nil "~2f" -1) "-1."
(cl-format nil "~3f" -1) "-1."
(cl-format nil "~4f" -1) "-1.0"
(cl-format nil "~8f" -1) " -1.0"
(cl-format nil "~1,1f" 0.1) ".1")
(simple-tests ampersand-tests
(cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5)
"The quick brown elephant jumped over 5 lazy dogs"
(cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5)
"The quick brown \nelephant jumped over 5 lazy dogs"
(cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
"The quick brown \nelephant jumped\n over 5 lazy dogs"
(cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
"The quick brown \nelephant jumped\n over 5 lazy dogs"
(cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
"\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs"
(cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10)
"The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs"
(cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n"
(cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n")
(simple-tests t-tests
(cl-format nil "~@{~&~A~8,4T~:*~A~}"
'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
"a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa"
(cl-format nil "~@{~&~A~,4T~:*~A~}"
'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
"a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa"
(cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
"a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa"
)
(simple-tests paren-tests
(cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here"
(cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here"
(cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT"
(cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!"
;; Test cases from CLtL 18.3 - string-upcase, et al.
(cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?"
(cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?"
(cl-format nil "~:(~A~)" " hello ") " Hello "
(cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")
"Occluded Casements Forestall Inadvertent Defenestration"
(cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search"
(cl-format nil "~:(~A~)" "DON'T!") "Don'T!" ;not "Don't!"
(cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c"
)
(simple-tests square-bracket-tests
;; Tests for format without modifiers
(cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n"
(cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n"
(cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n"
(cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n"
(cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n"
(cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n"
(cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n"
(cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n"
(cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n"
;; Tests for format with a colon
(cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n"
(cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n"
(cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n"
(cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n"
(cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n"
;; Tests for format with an at sign
(cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n"
(cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17)
"We had 15 wins (out of 17 tries).\n"
;; Format tests with directives
(cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7)
"Max 15: Blue team 7.\n"
(cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12)
"Max 15: Red team 12.\n"
(cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%"
15, -1, "(system failure)")
"Max 15: No team (system failure).\n"
;; Nested format tests
(cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%"
15, 0, 7, true)
"Max 15: Blue team 7 (complete success).\n"
(cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%"
15, 0, 7, false)
"Max 15: Blue team 7.\n"
;; Test the selector as part of the argument
(cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].")
"The answer is nothing."
(cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4)
"The answer is 4."
(cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22)
"The answer is 7 out of 22."
(cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4)
"The answer is something crazy."
)
(simple-tests curly-brace-plain-tests
;; Iteration from sublist
(cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ])
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ])
"Coordinates are [0,1] [1,0]\n"
(cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ])
"Coordinates are\n"
(cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ])
"Coordinates are none\n"
(cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~{~:}~%" "" [])
"Coordinates are\n"
(cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ])
"Coordinates are none\n"
)
(simple-tests curly-brace-colon-tests
;; Iteration from list of sublists
(cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ])
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ])
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ])
"Coordinates are [0,1] [1,0]\n"
(cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ])
"Coordinates are\n"
(cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ])
"Coordinates are none\n"
(cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~:{~:}~%" "" [])
"Coordinates are\n"
(cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ])
"Coordinates are none\n"
)
(simple-tests curly-brace-at-tests
;; Iteration from main list
(cl-format nil "Coordinates are~@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1)
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1)
"Coordinates are [0,1] [1,0]\n"
(cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%")
"Coordinates are\n"
(cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%")
"Coordinates are none\n"
(cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1)
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~@{~:}~%" "")
"Coordinates are\n"
(cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1)
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]")
"Coordinates are none\n"
)
(simple-tests curly-brace-colon-at-tests
;; Iteration from sublists on the main arg list
(cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1] )
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] )
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1])
"Coordinates are [0,1] [1,0]\n"
(cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%")
"Coordinates are\n"
(cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%")
"Coordinates are none\n"
(cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~@:{~:}~%" "")
"Coordinates are\n"
(cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]")
"Coordinates are none\n"
)
;; TODO tests for ~^ in ~[ constructs and other brackets
;; TODO test ~:^ generates an error when used improperly
;; TODO test ~:^ works in ~@:{...~}
(let [aseq '(a quick brown fox jumped over the lazy dog)
lseq (mapcat identity (for [x aseq] [x (.length (name x))]))]
(simple-tests up-tests
(cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog"
(cl-format nil "~{~a~0^, ~}" aseq) "a"
(cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over"
(cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox"
(cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox"
))
(simple-tests angle-bracket-tests
(cl-format nil "~<foo~;bar~;baz~>") "foobarbaz"
(cl-format nil "~20<foo~;bar~;baz~>") "foo bar baz"
(cl-format nil "~,,2<foo~;bar~;baz~>") "foo bar baz"
(cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz"
(cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz"
(cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz "
(cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz "
(cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz"
(cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz"
(cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz"
(cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo bar baz"
(cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo bar"
(cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo "
(cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") " foo"
)
(simple-tests angle-bracket-max-column-tests
(cl-format nil "~%;; ~{~<~%;; ~1,50:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance" "\\s")))
"\n;; This function computes the circular\n;; thermodynamic coefficient of the thrombulator\n;; angle for use in determining the reaction\n;; distance.\n"
(cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s"))))
(defn list-to-table [aseq column-width]
(let [stream (get-pretty-writer (java.io.StringWriter.))]
(binding [*out* stream]
(doseq [row aseq]
(doseq [col row]
(cl-format true "~4D~7,vT" col column-width))
(prn)))
(.flush stream)
(.toString (:base @@(:base @@stream)))))
(simple-tests column-writer-test
(list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8)
" 1 1 1 \n 2 4 8 \n 3 9 27 \n 4 16 64 \n 5 25 125 \n 6 36 216 \n 7 49 343 \n 8 64 512 \n 9 81 729 \n 10 100 1000 \n 11 121 1331 \n 12 144 1728 \n 13 169 2197 \n 14 196 2744 \n 15 225 3375 \n 16 256 4096 \n 17 289 4913 \n 18 324 5832 \n 19 361 6859 \n 20 400 8000 \n")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following tests are the various examples from the format
;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn expt [base pow] (reduce * (repeat pow base)))
(let [x 5, y "elephant", n 3]
(simple-tests cltl-intro-tests
(format nil "foo") "foo"
(format nil "The answer is ~D." x) "The answer is 5."
(format nil "The answer is ~3D." x) "The answer is 5."
(format nil "The answer is ~3,'0D." x) "The answer is 005."
(format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007."
(format nil "Look at the ~A!" y) "Look at the elephant!"
(format nil "Type ~:C to ~A." (char 4) "delete all your files")
"Type Control-D to delete all your files."
(format nil "~D item~:P found." n) "3 items found."
(format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here."
(format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here."
(format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies."))
(simple-tests cltl-B-tests
;; CLtL didn't have the colons here, but the spec requires them
(format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110"
(format nil "~,,' ,4:B" 0x1CE) "1 1100 1110"
(format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110"
;; This one was a nice idea, but nothing in the spec supports it working this way
;; (and SBCL doesn't work this way either)
;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110")
)
(simple-tests cltl-P-tests
(format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win"
(format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins"
(format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins")
(defn foo [x]
(format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F"
x x x x x x))
(simple-tests cltl-F-tests
(foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159"
(foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159"
(foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0"
(foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0"
(foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006")
(defn foo-e [x]
(format nil
"~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E"
x x x x))
;; Clojure doesn't support float/double differences in representation
(simple-tests cltl-E-tests
(foo-e 0.0314159) " 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2" ; Added this one
(foo-e 3.14159) " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0"
(foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0"
(foo-e 1100.0) " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3"
; In Clojure, this is identical to the above
; (foo-e 1100.0L0) " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3"
(foo-e 1.1E13) "*********| 11.00$+12|+.001E+16| 1.10E+13"
(foo-e 1.1E120) "*********|??????????|%%%%%%%%%|1.10E+120"
; Clojure doesn't support real numbers this large
; (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200"
)
(simple-tests cltl-E-scale-tests
(map
(fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|"
(- k 5) 3.14159)) ;Prints 13 lines
(range 13))
'("Scale factor -5: | 0.000003E+06|"
"Scale factor -4: | 0.000031E+05|"
"Scale factor -3: | 0.000314E+04|"
"Scale factor -2: | 0.003142E+03|"
"Scale factor -1: | 0.031416E+02|"
"Scale factor 0: | 0.314159E+01|"
"Scale factor 1: | 3.141590E+00|"
"Scale factor 2: | 31.41590E-01|"
"Scale factor 3: | 314.1590E-02|"
"Scale factor 4: | 3141.590E-03|"
"Scale factor 5: | 31415.90E-04|"
"Scale factor 6: | 314159.0E-05|"
"Scale factor 7: | 3141590.E-06|"))
(defn foo-g [x]
(format nil
"~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G"
x x x x))
;; Clojure doesn't support float/double differences in representation
(simple-tests cltl-G-tests
(foo-g 0.0314159) " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2"
(foo-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 "
(foo-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 "
(foo-g 31.4159) " 31. | 31.4 | 31.4 | 31. "
(foo-g 314.159) " 3.14E+2| 314. | 314. | 3.14E+2"
(foo-g 3141.59) " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3"
; In Clojure, this is identical to the above
; (foo-g 3141.59L0) " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3"
(foo-g 3.14E12) "*********|314.0$+10|0.314E+13| 3.14E+12"
(foo-g 3.14E120) "*********|?????????|%%%%%%%%%|3.14E+120"
; Clojure doesn't support real numbers this large
; (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200"
)
(defn type-clash-error [fun nargs argnum right-type wrong-type]
(format nil ;; CLtL has this format string slightly wrong
"~&Function ~S requires its ~:[~:R ~;~*~]~
argument to be of type ~S,~%but it was called ~
with an argument of type ~S.~%"
fun (= nargs 1) argnum right-type wrong-type))
(simple-tests cltl-Newline-tests
(type-clash-error 'aref nil 2 'integer 'vector)
"Function aref requires its second argument to be of type integer,
but it was called with an argument of type vector.\n"
(type-clash-error 'car 1 1 'list 'short-float)
"Function car requires its argument to be of type list,
but it was called with an argument of type short-float.\n")
(simple-tests cltl-?-tests
(format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) "<Foo 5> 7"
(format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) "<Foo 5> 7"
(format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) "<Foo 5> 7"
(format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) "<Foo 5> 14")
(defn f [n] (format nil "~@(~R~) error~:P detected." n))
(simple-tests cltl-paren-tests
(format nil "~@R ~(~@R~)" 14 14) "XIV xiv"
(f 0) "Zero errors detected."
(f 1) "One error detected."
(f 23) "Twenty-three errors detected.")
(let [*print-level* nil *print-length* 5]
(simple-tests cltl-bracket-tests
(format nil "~@[ print level = ~D~]~@[ print length = ~D~]"
*print-level* *print-length*)
" print length = 5"))
(let [foo "Items:~#[ none~; ~S~; ~S and ~S~
~:;~@{~#[~; and~] ~
~S~^,~}~]."]
(simple-tests cltl-bracket1-tests
(format nil foo) "Items: none."
(format nil foo 'foo) "Items: foo."
(format nil foo 'foo 'bar) "Items: foo and bar."
(format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz."
(format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux."))
(simple-tests cltl-curly-bracket-tests
(format nil
"The winners are:~{ ~S~}."
'(fred harry jill))
"The winners are: fred harry jill."
(format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3))
"Pairs: <a,1> <b,2> <c,3>."
(format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3)))
"Pairs: <a,1> <b,2> <c,3>."
(format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3)
"Pairs: <a,1> <b,2> <c,3>."
(format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3))
"Pairs: <a,1> <b,2> <c,3>.")
(simple-tests cltl-angle-bracket-tests
(format nil "~10<foo~;bar~>") "foo bar"
(format nil "~10:<foo~;bar~>") " foo bar"
(format nil "~10:@<foo~;bar~>") " foo bar "
(format nil "~10<foobar~>") " foobar"
(format nil "~10:<foobar~>") " foobar"
(format nil "~10@<foobar~>") "foobar "
(format nil "~10:@<foobar~>") " foobar ")
(let [donestr "Done.~^ ~D warning~:P.~^ ~D error~:P."
tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here
(simple-tests cltl-up-tests
(format nil donestr) "Done."
(format nil donestr 3) "Done. 3 warnings."
(format nil donestr 1 5) "Done. 1 warning. 5 errors."
(format nil tellstr 23) "Twenty-three."
(format nil tellstr nil "losers") "Losers."
(format nil tellstr 23 "losers") "Twenty-three losers."
(format nil "~15<~S~;~^~S~;~^~S~>" 'foo)
" foo"
(format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar)
"foo bar"
(format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz)
"foo bar baz"))
(simple-tests cltl-up-x3j13-tests
(format nil
"~:{/~S~^ ...~}"
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger/ice .../french ..."
(format nil
"~:{/~S~:^ ...~}"
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger .../ice .../french"
(format nil
"~:{/~S~#:^ ...~}" ;; This is wrong in CLtL
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger")