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