1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Wed Jul 28 00:33:02 2004 |
---|
4 | ;;;; Contains: Tests of the format directive ~R |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | ;;; Test of various radixes |
---|
9 | (compile-and-load "printer-aux.lsp") |
---|
10 | (compile-and-load "roman-numerals.lsp") |
---|
11 | |
---|
12 | (deftest format.r.1 |
---|
13 | (loop |
---|
14 | for i from 2 to 36 |
---|
15 | for s = (format nil "~~~dR" i) |
---|
16 | nconc |
---|
17 | (loop for x = (let ((bound (ash 1 (+ 2 (random 40))))) |
---|
18 | (- (random (* bound 2)) bound)) |
---|
19 | for s1 = (format nil s x) |
---|
20 | for s2 = (with-standard-io-syntax |
---|
21 | (write-to-string x :base i :readably nil)) |
---|
22 | repeat 100 |
---|
23 | unless (string= s1 s2) |
---|
24 | collect (list i x s1 s2))) |
---|
25 | nil) |
---|
26 | |
---|
27 | (deftest formatter.r.1 |
---|
28 | (loop |
---|
29 | for i from 2 to 36 |
---|
30 | for s = (format nil "~~~dR" i) |
---|
31 | for fn = (eval `(formatter ,s)) |
---|
32 | nconc |
---|
33 | (loop for x = (let ((bound (ash 1 (+ 2 (random 40))))) |
---|
34 | (- (random (* bound 2)) bound)) |
---|
35 | for s1 = (formatter-call-to-string fn x) |
---|
36 | for s2 = (with-standard-io-syntax |
---|
37 | (write-to-string x :base i :readably nil)) |
---|
38 | repeat 100 |
---|
39 | unless (string= s1 s2) |
---|
40 | collect (list i x s1 s2))) |
---|
41 | nil) |
---|
42 | |
---|
43 | (def-format-test format.r.2 |
---|
44 | "~2r" (14) "1110") |
---|
45 | |
---|
46 | (def-format-test format.r.3 |
---|
47 | "~3r" (29) "1002") |
---|
48 | |
---|
49 | (deftest format.r.4 |
---|
50 | (loop for base from 2 to 36 |
---|
51 | nconc |
---|
52 | (loop for mincol from 0 to 20 |
---|
53 | for fmt = (format nil "~~~D,~DR" base mincol) |
---|
54 | for s = (format nil fmt base) |
---|
55 | unless (if (<= mincol 2) |
---|
56 | (string= s "10") |
---|
57 | (string= (concatenate |
---|
58 | 'string |
---|
59 | (make-string (- mincol 2) |
---|
60 | :initial-element #\Space) |
---|
61 | "10") |
---|
62 | s)) |
---|
63 | collect (list base mincol s))) |
---|
64 | nil) |
---|
65 | |
---|
66 | (deftest formatter.r.4 |
---|
67 | (loop for base from 2 to 36 |
---|
68 | nconc |
---|
69 | (loop for mincol from 0 to 20 |
---|
70 | for fmt = (format nil "~~~D,~DR" base mincol) |
---|
71 | for fn = (eval `(formatter ,fmt)) |
---|
72 | for s = (formatter-call-to-string fn base) |
---|
73 | unless (if (<= mincol 2) |
---|
74 | (string= s "10") |
---|
75 | (string= (concatenate |
---|
76 | 'string |
---|
77 | (make-string (- mincol 2) |
---|
78 | :initial-element #\Space) |
---|
79 | "10") |
---|
80 | s)) |
---|
81 | collect (list base mincol s))) |
---|
82 | nil) |
---|
83 | |
---|
84 | (deftest format.r.5 |
---|
85 | (loop for base from 2 to 36 |
---|
86 | nconc |
---|
87 | (loop for mincol from 0 to 20 |
---|
88 | for fmt = (format nil "~~~D,~D,'*r" base mincol) |
---|
89 | for s = (format nil fmt base) |
---|
90 | unless (if (<= mincol 2) |
---|
91 | (string= s "10") |
---|
92 | (string= (concatenate |
---|
93 | 'string |
---|
94 | (make-string (- mincol 2) |
---|
95 | :initial-element #\*) |
---|
96 | "10") |
---|
97 | s)) |
---|
98 | collect (list base mincol s))) |
---|
99 | nil) |
---|
100 | |
---|
101 | (deftest formatter.r.5 |
---|
102 | (loop for base from 2 to 36 |
---|
103 | nconc |
---|
104 | (loop for mincol from 0 to 20 |
---|
105 | for fmt = (format nil "~~~D,~D,'*r" base mincol) |
---|
106 | for fn = (eval `(formatter ,fmt)) |
---|
107 | for s = (formatter-call-to-string fn base) |
---|
108 | unless (if (<= mincol 2) |
---|
109 | (string= s "10") |
---|
110 | (string= (concatenate |
---|
111 | 'string |
---|
112 | (make-string (- mincol 2) |
---|
113 | :initial-element #\*) |
---|
114 | "10") |
---|
115 | s)) |
---|
116 | collect (list base mincol s))) |
---|
117 | nil) |
---|
118 | |
---|
119 | (deftest format.r.6 |
---|
120 | (loop for base from 2 to 36 |
---|
121 | for s = (format nil "~vr" base (1+ base)) |
---|
122 | unless (string= s "11") |
---|
123 | collect (list base s)) |
---|
124 | nil) |
---|
125 | |
---|
126 | (deftest formatter.r.6 |
---|
127 | (let ((fn (formatter "~vr"))) |
---|
128 | (loop for base from 2 to 36 |
---|
129 | for s = (formatter-call-to-string fn base (1+ base)) |
---|
130 | unless (string= s "11") |
---|
131 | collect (list base s))) |
---|
132 | nil) |
---|
133 | |
---|
134 | (defparameter *english-number-names* |
---|
135 | '("zero" |
---|
136 | "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" |
---|
137 | "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" |
---|
138 | "seventeen" "eighteen" "nineteen" "twenty" |
---|
139 | "twenty-one" "twenty-two" "twenty-three" "twenty-four" "twenty-five" |
---|
140 | "twenty-six" "twenty-seven" "twenty-eight" "twenty-nine" "thirty" |
---|
141 | "thirty-one" "thirty-two" "thirty-three" "thirty-four" "thirty-five" |
---|
142 | "thirty-six" "thirty-seven" "thirty-eight" "thirty-nine" "forty" |
---|
143 | "forty-one" "forty-two" "forty-three" "forty-four" "forty-five" |
---|
144 | "forty-six" "forty-seven" "forty-eight" "forty-nine" "fifty" |
---|
145 | "fifty-one" "fifty-two" "fifty-three" "fifty-four" "fifty-five" |
---|
146 | "fifty-six" "fifty-seven" "fifty-eight" "fifty-nine" "sixty" |
---|
147 | "sixty-one" "sixty-two" "sixty-three" "sixty-four" "sixty-five" |
---|
148 | "sixty-six" "sixty-seven" "sixty-eight" "sixty-nine" "seventy" |
---|
149 | "seventy-one" "seventy-two" "seventy-three" "seventy-four" "seventy-five" |
---|
150 | "seventy-six" "seventy-seven" "seventy-eight" "seventy-nine" "eighty" |
---|
151 | "eighty-one" "eighty-two" "eighty-three" "eighty-four" "eighty-five" |
---|
152 | "eighty-six" "eighty-seven" "eighty-eight" "eighty-nine" "ninety" |
---|
153 | "ninety-one" "ninety-two" "ninety-three" "ninety-four" "ninety-five" |
---|
154 | "ninety-six" "ninety-seven" "ninety-eight" "ninety-nine" "one hundred")) |
---|
155 | |
---|
156 | (deftest format.r.7 |
---|
157 | (loop for i from 0 to 100 |
---|
158 | for s1 = (format nil "~r" i) |
---|
159 | for s2 in *english-number-names* |
---|
160 | unless (string= s1 s2) |
---|
161 | collect (list i s1 s2)) |
---|
162 | nil) |
---|
163 | |
---|
164 | (deftest formatter.r.7 |
---|
165 | (let ((fn (formatter "~r"))) |
---|
166 | (loop for i from 0 to 100 |
---|
167 | for s1 = (formatter-call-to-string fn i) |
---|
168 | for s2 in *english-number-names* |
---|
169 | unless (string= s1 s2) |
---|
170 | collect (list i s1 s2))) |
---|
171 | nil) |
---|
172 | |
---|
173 | (deftest format.r.7a |
---|
174 | (loop for i from 1 to 100 |
---|
175 | for s1 = (format nil "~r" (- i)) |
---|
176 | for s2 in (cdr *english-number-names*) |
---|
177 | for s3 = (concatenate 'string "negative " s2) |
---|
178 | for s4 = (concatenate 'string "minus " s2) |
---|
179 | unless (or (string= s1 s3) (string= s1 s4)) |
---|
180 | collect (list i s1 s3 s4)) |
---|
181 | nil) |
---|
182 | |
---|
183 | (def-format-test format.r.8 |
---|
184 | "~vr" (nil 5) "five") |
---|
185 | |
---|
186 | (def-format-test format.r.9 |
---|
187 | "~#r" (4 nil nil) "11" 2) |
---|
188 | |
---|
189 | (deftest format.r.10 |
---|
190 | (with-standard-io-syntax |
---|
191 | (let ((*print-radix* t)) |
---|
192 | (format nil "~10r" 123))) |
---|
193 | "123") |
---|
194 | |
---|
195 | (deftest formatter.r.10 |
---|
196 | (let ((fn (formatter "~10r"))) |
---|
197 | (with-standard-io-syntax |
---|
198 | (let ((*print-radix* t)) |
---|
199 | (values |
---|
200 | (format nil fn 123) |
---|
201 | (formatter-call-to-string fn 123))))) |
---|
202 | "123" |
---|
203 | "123") |
---|
204 | |
---|
205 | (def-format-test format.r.11 |
---|
206 | "~8@R" (65) "+101") |
---|
207 | |
---|
208 | (def-format-test format.r.12 |
---|
209 | "~2:r" (126) "1,111,110") |
---|
210 | |
---|
211 | (def-format-test format.r.13 |
---|
212 | "~3@:r" (#3r2120012102) "+2,120,012,102") |
---|
213 | |
---|
214 | (deftest format.r.14 |
---|
215 | (loop |
---|
216 | for i from 2 to 36 |
---|
217 | for s = (format nil "~~~d:R" i) |
---|
218 | nconc |
---|
219 | (loop for x = (let ((bound (ash 1 (+ 2 (random 40))))) |
---|
220 | (- (random (* bound 2)) bound)) |
---|
221 | for s1 = (remove #\, (format nil s x)) |
---|
222 | for y = (let ((*read-base* i)) (read-from-string s1)) |
---|
223 | repeat 100 |
---|
224 | unless (= x y) |
---|
225 | collect (list i x s1 y))) |
---|
226 | nil) |
---|
227 | |
---|
228 | (deftest format.r.15 |
---|
229 | (loop |
---|
230 | for i = (+ 2 (random 35)) |
---|
231 | for interval = (1+ (random 20)) |
---|
232 | for comma = (loop for c = (random-from-seq +standard-chars+) |
---|
233 | unless (alphanumericp c) |
---|
234 | return c) |
---|
235 | for s = (format nil "~~~d,,,'~c,~d:R" i comma interval) |
---|
236 | for x = (let ((bound (ash 1 (+ 2 (random 40))))) |
---|
237 | (- (random (* bound 2)) bound)) |
---|
238 | for s1 = (remove comma (format nil s x)) |
---|
239 | for y = (let ((*read-base* i)) (read-from-string s1)) |
---|
240 | repeat 1000 |
---|
241 | unless (or (and (eql comma #\-) (< x 0)) |
---|
242 | (= x y)) |
---|
243 | collect (list i interval comma x s1 y)) |
---|
244 | nil) |
---|
245 | |
---|
246 | (def-format-test format.r.16 |
---|
247 | "~2,,,,1000000000000000000r" (17) "10001") |
---|
248 | |
---|
249 | (def-format-test format.r.17 |
---|
250 | "~8,10:@r" (#o526104) " +526,104") |
---|
251 | |
---|
252 | (defparameter *english-ordinal-names* |
---|
253 | '("zeroth" |
---|
254 | "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth" "tenth" |
---|
255 | "eleventh" "twelfth" "thirteenth" "fourteenth" "fifteenth" "sixteenth" |
---|
256 | "seventeenth" "eighteenth" "nineteenth" "twentieth" |
---|
257 | "twenty-first" "twenty-second" "twenty-third" "twenty-fourth" "twenty-fifth" |
---|
258 | "twenty-sixth" "twenty-seventh" "twenty-eighth" "twenty-ninth" "thirtieth" |
---|
259 | "thirty-first" "thirty-second" "thirty-third" "thirty-fourth" "thirty-fifth" |
---|
260 | "thirty-sixth" "thirty-seventh" "thirty-eighth" "thirty-ninth" "fortieth" |
---|
261 | "forty-first" "forty-second" "forty-third" "forty-fourth" "forty-fifth" |
---|
262 | "forty-sixth" "forty-seventh" "forty-eighth" "forty-ninth" "fiftieth" |
---|
263 | "fifty-first" "fifty-second" "fifty-third" "fifty-fourth" "fifty-fifth" |
---|
264 | "fifty-sixth" "fifty-seventh" "fifty-eighth" "fifty-ninth" "sixtieth" |
---|
265 | "sixty-first" "sixty-second" "sixty-third" "sixty-fourth" "sixty-fifth" |
---|
266 | "sixty-sixth" "sixty-seventh" "sixty-eighth" "sixty-ninth" "seventieth" |
---|
267 | "seventy-first" "seventy-second" "seventy-third" "seventy-fourth" "seventy-fifth" |
---|
268 | "seventy-sixth" "seventy-seventh" "seventy-eighth" "seventy-ninth" "eightieth" |
---|
269 | "eighty-first" "eighty-second" "eighty-third" "eighty-fourth" "eighty-fifth" |
---|
270 | "eighty-sixth" "eighty-seventh" "eighty-eighth" "eighty-ninth" "ninetieth" |
---|
271 | "ninety-first" "ninety-second" "ninety-third" "ninety-fourth" "ninety-fifth" |
---|
272 | "ninety-sixth" "ninety-seventh" "ninety-eighth" "ninety-ninth" "one hundredth")) |
---|
273 | |
---|
274 | (deftest format.r.18 |
---|
275 | (loop for i from 0 to 100 |
---|
276 | for s1 = (format nil "~:r" i) |
---|
277 | for s2 in *english-ordinal-names* |
---|
278 | unless (string= s1 s2) |
---|
279 | collect (list i s1 s2)) |
---|
280 | nil) |
---|
281 | |
---|
282 | (deftest formatter.r.18 |
---|
283 | (let ((fn (formatter "~:r"))) |
---|
284 | (loop for i from 0 to 100 |
---|
285 | for s1 = (formatter-call-to-string fn i) |
---|
286 | for s2 in *english-ordinal-names* |
---|
287 | unless (string= s1 s2) |
---|
288 | collect (list i s1 s2))) |
---|
289 | nil) |
---|
290 | |
---|
291 | (deftest format.r.18a |
---|
292 | (loop for i from 1 to 100 |
---|
293 | for s1 = (format nil "~:r" (- i)) |
---|
294 | for s2 in (cdr *english-ordinal-names*) |
---|
295 | for s3 = (concatenate 'string "negative " s2) |
---|
296 | for s4 = (concatenate 'string "minus " s2) |
---|
297 | unless (or (string= s1 s3) (string= s1 s4)) |
---|
298 | collect (list i s1 s3 s4)) |
---|
299 | nil) |
---|
300 | |
---|
301 | (deftest format.r.19 |
---|
302 | (loop for i from 1 |
---|
303 | for s1 in *roman-numerals* |
---|
304 | for s2 = (format nil "~@R" i) |
---|
305 | unless (string= s1 s2) |
---|
306 | collect (list i s1 s2)) |
---|
307 | nil) |
---|
308 | |
---|
309 | (deftest formatter.r.19 |
---|
310 | (let ((fn (formatter "~@r"))) |
---|
311 | (loop for i from 1 |
---|
312 | for s1 in *roman-numerals* |
---|
313 | for s2 = (formatter-call-to-string fn i) |
---|
314 | unless (string= s1 s2) |
---|
315 | collect (list i s1 s2))) |
---|
316 | nil) |
---|
317 | |
---|
318 | ;;; Old roman numerals |
---|
319 | |
---|
320 | (defun old-roman-numeral (x) |
---|
321 | (assert (typep x '(integer 1))) |
---|
322 | (let ((n-m 0) |
---|
323 | (n-d 0) |
---|
324 | (n-c 0) |
---|
325 | (n-l 0) |
---|
326 | (n-x 0) |
---|
327 | (n-v 0) |
---|
328 | ) |
---|
329 | (loop while (>= x 1000) do (incf n-m) (decf x 1000)) |
---|
330 | (when (>= x 500) (incf n-d) (decf x 500)) |
---|
331 | (loop while (>= x 100) do (incf n-c) (decf x 100)) |
---|
332 | (when (>= x 50) (incf n-l) (decf x 50)) |
---|
333 | (loop while (>= x 10) do (incf n-x) (decf x 10)) |
---|
334 | (when (>= x 5) (incf n-v) (decf x 5)) |
---|
335 | (concatenate 'string |
---|
336 | (make-string n-m :initial-element #\M) |
---|
337 | (make-string n-d :initial-element #\D) |
---|
338 | (make-string n-c :initial-element #\C) |
---|
339 | (make-string n-l :initial-element #\L) |
---|
340 | (make-string n-x :initial-element #\X) |
---|
341 | (make-string n-v :initial-element #\V) |
---|
342 | (make-string x :initial-element #\I)))) |
---|
343 | |
---|
344 | (deftest format.r.20 |
---|
345 | (loop for i from 1 to 4999 |
---|
346 | for s1 = (format nil "~:@r" i) |
---|
347 | for s2 = (old-roman-numeral i) |
---|
348 | unless (string= s1 s2) |
---|
349 | collect (list i s1 s2)) |
---|
350 | nil) |
---|
351 | |
---|
352 | (deftest formatter.r.20 |
---|
353 | (let ((fn (formatter "~@:R"))) |
---|
354 | (loop for i from 1 to 4999 |
---|
355 | for s1 = (formatter-call-to-string fn i) |
---|
356 | for s2 = (old-roman-numeral i) |
---|
357 | unless (string= s1 s2) |
---|
358 | collect (list i s1 s2))) |
---|
359 | nil) |
---|
360 | |
---|
361 | (deftest format.r.21 |
---|
362 | (loop for i from 1 to 4999 |
---|
363 | for s1 = (format nil "~:@r" i) |
---|
364 | for s2 = (format nil "~@:R" i) |
---|
365 | unless (string= s1 s2) |
---|
366 | collect (list i s1 s2)) |
---|
367 | nil) |
---|
368 | |
---|
369 | ;; Combinations of mincol and comma chars |
---|
370 | |
---|
371 | (def-format-test format.r.22 |
---|
372 | "~2,12,,'*:r" (#b1011101) " 1*011*101") |
---|
373 | |
---|
374 | (def-format-test format.r.23 |
---|
375 | "~3,14,'X,',:R" (#3r1021101) "XXXXX1,021,101") |
---|
376 | |
---|
377 | ;; v directive in various positions |
---|
378 | |
---|
379 | (def-format-test format.r.24 |
---|
380 | "~10,vr" (nil 12345) "12345") |
---|
381 | |
---|
382 | (deftest format.r.25 |
---|
383 | (loop for i from 0 to 5 |
---|
384 | for s = (format nil "~10,vr" i 12345) |
---|
385 | unless (string= s "12345") |
---|
386 | collect (list i s)) |
---|
387 | nil) |
---|
388 | |
---|
389 | (deftest formatter.r.25 |
---|
390 | (let ((fn (formatter "~10,vr"))) |
---|
391 | (loop for i from 0 to 5 |
---|
392 | for s = (formatter-call-to-string fn i 12345) |
---|
393 | unless (string= s "12345") |
---|
394 | collect (list i s))) |
---|
395 | nil) |
---|
396 | |
---|
397 | (def-format-test format.r.26 |
---|
398 | "~10,#r" (12345 nil nil nil nil nil) " 12345" 5) |
---|
399 | |
---|
400 | (def-format-test format.r.27 |
---|
401 | "~10,12,vr" (#\/ 123456789) "///123456789") |
---|
402 | |
---|
403 | (def-format-test format.r.28 |
---|
404 | "~10,,,v:r" (#\/ 123456789) "123/456/789") |
---|
405 | |
---|
406 | (def-format-test format.r.29 |
---|
407 | "~10,,,v:r" (nil 123456789) "123,456,789") |
---|
408 | |
---|
409 | (def-format-test format.r.30 |
---|
410 | "~8,,,,v:R" (nil #o12345670) "12,345,670") |
---|
411 | |
---|
412 | (def-format-test format.r.31 |
---|
413 | "~8,,,,v:R" (2 #o12345670) "12,34,56,70") |
---|
414 | |
---|
415 | (def-format-test format.r.32 |
---|
416 | "~16,,,,#:r" (#x12345670 nil nil nil) "1234,5670" 3) |
---|
417 | |
---|
418 | (def-format-test format.r.33 |
---|
419 | "~16,,,,1:r" (#x12345670) "1,2,3,4,5,6,7,0") |
---|
420 | |
---|
421 | ;;; Explicit signs |
---|
422 | |
---|
423 | (def-format-test format.r.34 |
---|
424 | "~+10r" (12345) "12345") |
---|
425 | |
---|
426 | (def-format-test format.r.35 |
---|
427 | "~10,+8r" (12345) " 12345") |
---|
428 | |
---|
429 | (def-format-test format.r.36 |
---|
430 | "~10,0r" (12345) "12345") |
---|
431 | |
---|
432 | (def-format-test format.r.37 |
---|
433 | "~10,-1r" (12345) "12345") |
---|
434 | |
---|
435 | (def-format-test format.r.38 |
---|
436 | "~10,-1000000000000000r" (12345) "12345") |
---|
437 | |
---|
438 | ;;; Randomized test |
---|
439 | |
---|
440 | (deftest format.r.39 |
---|
441 | (let ((fn (formatter "~v,v,v,v,vr"))) |
---|
442 | (loop |
---|
443 | for radix = (+ 2 (random 35)) |
---|
444 | for mincol = (and (coin) (random 50)) |
---|
445 | for padchar = (and (coin) |
---|
446 | (random-from-seq +standard-chars+)) |
---|
447 | for commachar = (and (coin) |
---|
448 | (random-from-seq +standard-chars+)) |
---|
449 | for commaint = (and (coin) (1+ (random 10))) |
---|
450 | for k = (ash 1 (+ 2 (random 30))) |
---|
451 | for x = (- (random (+ k k)) k) |
---|
452 | for fmt = (concatenate |
---|
453 | 'string |
---|
454 | (format nil "~~~d," radix) |
---|
455 | (if mincol (format nil "~d," mincol) ",") |
---|
456 | (if padchar (format nil "'~c," padchar) ",") |
---|
457 | (if commachar (format nil "'~c," commachar) ",") |
---|
458 | (if commaint (format nil "~dr" commaint) "r")) |
---|
459 | for s1 = (format nil fmt x) |
---|
460 | for s2 = (format nil "~v,v,v,v,vr" radix mincol padchar commachar commaint x) |
---|
461 | for s3 = (formatter-call-to-string fn radix mincol padchar commachar commaint x) |
---|
462 | repeat 2000 |
---|
463 | unless (and (string= s1 s2) |
---|
464 | (string= s1 s3)) |
---|
465 | collect (list radix mincol padchar commachar commaint fmt x s1 s2 s3))) |
---|
466 | nil) |
---|