Mercurial > lasercutter

comparison src/clojure/contrib/test_contrib/pprint/test_cl_format.clj @ 10:ef7dbbd6452c

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