source: trunk/source/tests/ansi-tests/format-r.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 13.3 KB
Line 
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)
Note: See TracBrowser for help on using the repository browser.