Mercurial > lasercutter

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