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

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

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

File size: 16.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jul 31 05:19:39 2004
4;;;; Contains: Tests of the ~D format directive
5
6(in-package :cl-test)
7
8(compile-and-load "printer-aux.lsp")
9
10(deftest format.d.1
11  (with-standard-io-syntax
12   (loop for x = (ash 1 (+ 2 (random 80)))
13         for i = (- (random (+ x x)) x)
14         for s1 = (format nil "~D" i)
15         for j = (read-from-string s1)
16         repeat 1000
17         when (or (/= i j)
18                  (find #\. s1)
19                  (find #\+ s1)
20                  (find-if #'alpha-char-p s1))
21         collect (list i s1 j)))
22  nil)
23
24(deftest formatter.d.1
25  (let ((fn (formatter "~D")))
26    (with-standard-io-syntax
27     (loop for x = (ash 1 (+ 2 (random 80)))
28           for i = (- (random (+ x x)) x)
29           for s1 = (formatter-call-to-string fn i)
30           for j = (read-from-string s1)
31           repeat 1000
32           when (or (/= i j)
33                    (find #\. s1)
34                    (find #\+ s1)
35                    (find-if #'alpha-char-p s1))
36           collect (list i s1 j))))
37  nil)
38
39(deftest format.d.2
40  (with-standard-io-syntax
41   (loop for x = (ash 1 (+ 2 (random 80)))
42         for i = (- (random (+ x x)) x)
43         for s1 = (format nil "~@d" i)
44         for j = (read-from-string s1)
45         repeat 1000
46         when (or (/= i j)
47                  (find #\. s1)
48                  ;; (find #\+ s1)
49                  (find-if #'alpha-char-p s1))
50         collect (list i s1 j)))
51  nil)
52
53(deftest formatter.d.2
54  (let ((fn (formatter "~@D")))
55    (with-standard-io-syntax
56     (loop for x = (ash 1 (+ 2 (random 80)))
57           for i = (- (random (+ x x)) x)
58           for s1 = (formatter-call-to-string fn i)
59           for j = (read-from-string s1)
60           repeat 1000
61           when (or (/= i j)
62                    (find #\. s1)
63                    ;; (find #\+ s1)
64                    (find-if #'alpha-char-p s1))
65           collect (list i s1 j))))
66  nil)
67
68(deftest format.d.3
69  (with-standard-io-syntax
70   (loop for x = (ash 1 (+ 2 (random 80)))
71         for mincol = (random 30)
72         for i = (- (random (+ x x)) x)
73         for s1 = (format nil "~d" i)
74         for s2 = (format nil (format nil "~~~dd" mincol) i)
75         for pos = (search s1 s2)
76         repeat 1000
77         when (or (null pos)
78                  (and (> mincol (length s1))
79                       (or (/= (length s2) mincol)
80                           (not (eql (position #\Space s2 :test-not #'eql)
81                                     (- (length s2) (length s1)))))))
82         collect (list i mincol s1 s2 pos)))
83  nil)
84
85(deftest formatter.d.3
86  (with-standard-io-syntax
87   (loop for x = (ash 1 (+ 2 (random 80)))
88         for mincol = (random 30)
89         for i = (- (random (+ x x)) x)
90         for s1 = (format nil "~d" i)
91         for format-string = (format nil "~~~dd" mincol)
92         ; for s2 = (format nil format-string i)
93         for fn = (eval `(formatter ,format-string))
94         for s2 = (formatter-call-to-string fn i)
95         for pos = (search s1 s2)
96         repeat 100
97         when (or (null pos)
98                  (and (> mincol (length s1))
99                       (or (/= (length s2) mincol)
100                           (not (eql (position #\Space s2 :test-not #'eql)
101                                     (- (length s2) (length s1)))))))
102         collect (list i mincol s1 s2 pos)))
103  nil)
104
105(deftest format.d.4
106  (with-standard-io-syntax
107   (loop with limit = 10
108         with count = 0
109         for x = (ash 1 (+ 2 (random 80)))
110         for mincol = (random 30)
111         for i = (- (random (+ x x)) x)
112         for s1 = (format nil "~@D" i)
113         for format-string = (format nil "~~~d@d" mincol)
114         for s2 = (format nil format-string i)
115         for pos = (search s1 s2)
116         repeat 1000
117         when (or (null pos)
118                  (and (>= i 0) (not (eql (elt s1 0) #\+)))
119                  (and (> mincol (length s1))
120                       (or (/= (length s2) mincol)
121                           (not (eql (position #\Space s2 :test-not #'eql)
122                                     (- (length s2) (length s1)))))))
123         collect (if (> (incf count) limit)
124                     "Count limit exceeded"
125                     (list i mincol s1 format-string s2 pos))
126         while (<= count limit)))
127  nil)
128
129(deftest formatter.d.4
130  (with-standard-io-syntax
131   (loop with limit = 10
132         with count = 0
133         for x = (ash 1 (+ 2 (random 80)))
134         for mincol = (random 30)
135         for i = (- (random (+ x x)) x)
136         for s1 = (format nil "~@D" i)
137         for format-string = (format nil "~~~d@d" mincol)
138         for fn = (eval `(formatter ,format-string))
139         for s2 = (formatter-call-to-string fn i)
140         for pos = (search s1 s2)
141         repeat 100
142         when (or (null pos)
143                  (and (>= i 0) (not (eql (elt s1 0) #\+)))
144                  (and (> mincol (length s1))
145                       (or (/= (length s2) mincol)
146                           (not (eql (position #\Space s2 :test-not #'eql)
147                                     (- (length s2) (length s1)))))))
148         collect (if (> (incf count) limit)
149                     "Count limit exceeded"
150                   (list i mincol s1 s2 pos))
151         while (<= count limit)))
152  nil)
153
154(deftest format.d.5
155  (with-standard-io-syntax
156   (loop for x = (ash 1 (+ 2 (random 80)))
157         for mincol = (random 30)
158         for padchar = (random-from-seq +standard-chars+)
159         for i = (- (random (+ x x)) x)
160         for s1 = (format nil "~d" i)
161         for s2 = (format nil (format nil "~~~d,'~cd" mincol padchar) i)
162         for pos = (search s1 s2)
163         repeat 1000
164         when (or (null pos)
165                  (and (> mincol (length s1))
166                       (or (/= (length s2) mincol)
167                           (find padchar s2 :end (- (length s2) (length s1))
168                                 :test-not #'eql))))
169         collect (list i mincol s1 s2 pos)))
170  nil)
171
172(deftest formatter.d.5
173  (with-standard-io-syntax
174   (loop for x = (ash 1 (+ 2 (random 80)))
175         for mincol = (random 30)
176         for padchar = (random-from-seq +standard-chars+)
177         for i = (- (random (+ x x)) x)
178         for s1 = (format nil "~d" i)
179         for format-string = (format nil "~~~d,'~cd" mincol padchar)
180         for fn = (eval `(formatter ,format-string))
181         for s2 = (formatter-call-to-string fn i)
182         for pos = (search s1 s2)
183         repeat 100
184         when (or (null pos)
185                  (and (> mincol (length s1))
186                       (or (/= (length s2) mincol)
187                           (find padchar s2 :end (- (length s2) (length s1))
188                                 :test-not #'eql))))
189         collect (list i mincol s1 s2 pos)))
190  nil)
191
192(deftest format.d.6
193  (let ((fn (formatter "~v,vd")))
194    (with-standard-io-syntax
195     (loop for x = (ash 1 (+ 2 (random 80)))
196           for mincol = (random 30)
197           for padchar = (random-from-seq +standard-chars+)
198           for i = (- (random (+ x x)) x)
199           for s1 = (format nil "~d" i)
200           for s2 = (format nil "~v,vD" mincol padchar i)
201           for s3 = (formatter-call-to-string fn mincol padchar i)
202           for pos = (search s1 s2)
203           repeat 1000
204           when (or (null pos)
205                    (not (string= s2 s3))
206                    (and (> mincol (length s1))
207                         (or (/= (length s2) mincol)
208                             (find padchar s2 :end (- (length s2) (length s1))
209                                   :test-not #'eql))))
210           collect (list i mincol s1 s2 s3 pos))))
211  nil)
212
213(deftest format.d.7
214  (let ((fn (formatter "~v,v@D")))
215    (with-standard-io-syntax
216     (loop with limit = 10
217           with count = 0
218           for x = (ash 1 (+ 2 (random 80)))
219           for mincol = (random 30)
220           for padchar = (random-from-seq +standard-chars+)
221           for i = (- (random (+ x x)) x)
222           for s1 = (format nil "~@d" i)
223           for s2 = (format nil "~v,v@d" mincol padchar i)
224           for s3 = (formatter-call-to-string fn mincol padchar i)
225           for pos = (search s1 s2)
226           repeat 1000
227           when (or (null pos)
228                    (not (string= s2 s3))
229                    (and (>= i 0) (not (eql (elt s1 0) #\+)))
230                    (and (> mincol (length s1))
231                         (or (/= (length s2) mincol)
232                             (find padchar s2 :end (- (length s2) (length s1))
233                                   :test-not #'eql))))
234           collect (if (> (incf count) limit)
235                       "Count limit exceeded"
236                     (list i mincol s1 s2 s3 pos))
237           while (<= count limit))))
238  nil)
239
240;;; Comma tests
241
242(deftest format.d.8
243  (let ((fn1 (formatter "~d"))
244        (fn2 (formatter "~:d")))
245    (loop for i from -999 to 999
246          for s1 = (format nil "~d" i)
247          for s2 = (format nil "~:d" i)
248          for s3 = (formatter-call-to-string fn1 i)
249          for s4 = (formatter-call-to-string fn2 i)
250          unless (and (string= s1 s2) (string= s1 s3) (string= s1 s4))
251          collect (list i s1 s2 s3 s4)))
252  nil)
253
254(deftest format.d.9
255  (let ((fn1 (formatter "~d"))
256        (fn2 (formatter "~:d")))
257    (with-standard-io-syntax
258     (loop for x = (ash 1 (+ 2 (random 80)))
259           for i = (- (random (+ x x)) x)
260           for commachar = #\,
261           for s1 = (format nil "~d" i)
262           for s2 = (format nil "~:d" i)
263           for s3 = (formatter-call-to-string fn1 i)
264           for s4 = (formatter-call-to-string fn2 i)
265           repeat 1000
266           unless (and (string= s1 s3)
267                       (string= s2 s4)
268                       (string= s1 (remove commachar s2))
269                       (not (eql (elt s2 0) commachar))
270                       (or (>= i 0) (not (eql (elt s2 1) commachar)))
271                       (let ((len (length s2))
272                             (ci+1 4))
273                         (loop for i from (if (< i 0) 2 1) below len
274                               always (if (= (mod (- len i) ci+1) 0)
275                                          (eql (elt s2 i) commachar)
276                                        (find (elt s2 i) "0123456789")))))
277           collect (list x i commachar s1 s2 s3 s4))))
278  nil)
279
280(deftest format.d.10
281  (let ((fn (formatter "~,,v:d")))
282    (with-standard-io-syntax
283     (loop for x = (ash 1 (+ 2 (random 80)))
284           for i = (- (random (+ x x)) x)
285           for commachar = (random-from-seq +standard-chars+)
286           for s1 = (format nil "~d" i)
287           for s2 = (format nil "~,,v:d" commachar i)
288           for s3 = (formatter-call-to-string fn commachar i)
289           repeat 1000
290           unless (and
291                   (string= s2 s3)
292                   (eql (elt s1 0) (elt s2 0))
293                   (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
294                   (let ((len (length s2))
295                         (ci+1 4)
296                         (j (if (< i 0) 1 0)))
297                     (loop for i from (if (< i 0) 2 1) below len
298                           always (if (= (mod (- len i) ci+1) 0)
299                                      (eql (elt s2 i) commachar)
300                                    (eql (elt s1 (incf j)) (elt s2 i))))))
301           collect (list x i commachar s1 s2 s3))))
302  nil)
303
304(deftest format.d.11
305  (with-standard-io-syntax
306   (loop for x = (ash 1 (+ 2 (random 80)))
307         for i = (- (random (+ x x)) x)
308         for commachar = (random-from-seq +standard-chars+)
309         for s1 = (format nil "~d" i)
310         for format-string = (format nil "~~,,'~c:d" commachar)
311         for s2 = (format nil format-string i)
312         repeat 1000
313         unless (and
314                 (eql (elt s1 0) (elt s2 0))
315                 (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
316                 (let ((len (length s2))
317                      (ci+1 4)
318                      (j (if (< i 0) 1 0)))
319                  (loop for i from (if (< i 0) 2 1) below len
320                        always (if (= (mod (- len i) ci+1) 0)
321                                   (eql (elt s2 i) commachar)
322                                 (eql (elt s1 (incf j)) (elt s2 i))))))
323         collect (list x i commachar s1 s2)))
324  nil)
325
326(deftest formatter.d.11
327  (with-standard-io-syntax
328   (loop for x = (ash 1 (+ 2 (random 80)))
329         for i = (- (random (+ x x)) x)
330         for commachar = (random-from-seq +standard-chars+)
331         for s1 = (format nil "~d" i)
332         for format-string = (format nil "~~,,'~c:d" commachar)
333         for fn = (eval `(formatter ,format-string))
334         ; for s2 = (format nil format-string i)
335         for s2 = (formatter-call-to-string fn i)
336         repeat 100
337         unless (and
338                 (eql (elt s1 0) (elt s2 0))
339                 (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
340                 (let ((len (length s2))
341                      (ci+1 4)
342                      (j (if (< i 0) 1 0)))
343                  (loop for i from (if (< i 0) 2 1) below len
344                        always (if (= (mod (- len i) ci+1) 0)
345                                   (eql (elt s2 i) commachar)
346                                 (eql (elt s1 (incf j)) (elt s2 i))))))
347         collect (list x i commachar s1 s2)))
348  nil)
349
350(deftest format.d.12
351  (let ((fn (formatter "~,,v,v:d")))
352    (with-standard-io-syntax
353     (loop for x = (ash 1 (+ 2 (random 80)))
354           for i = (- (random (+ x x)) x)
355           for commachar = (random-from-seq +standard-chars+)
356           for commaint = (1+ (random 20))
357           for s1 = (format nil "~d" i)
358           for s2 = (format nil "~,,v,v:D" commachar commaint i)
359           for s3 = (formatter-call-to-string fn commachar commaint i)
360           repeat 1000
361           unless (and
362                   (string= s2 s3)
363                   (eql (elt s1 0) (elt s2 0))
364                   (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
365                   (let ((len (length s2))
366                         (ci+1 (1+ commaint))
367                         (j (if (< i 0) 1 0)))
368                     (loop for i from (if (< i 0) 2 1) below len
369                           always (if (= (mod (- len i) ci+1) 0)
370                                      (eql (elt s2 i) commachar)
371                                    (eql (elt s1 (incf j)) (elt s2 i))))))
372           collect (list x i commachar s1 s2 s3))))
373  nil)
374
375(deftest format.d.13
376  (let ((fn (formatter "~,,v,v:@D")))
377    (with-standard-io-syntax
378     (loop for x = (ash 1 (+ 2 (random 80)))
379           for i = (- (random (+ x x)) x)
380           for commachar = (random-from-seq +standard-chars+)
381           for commaint = (1+ (random 20))
382           for s1 = (format nil "~@d" i)
383           for s2 = (format nil "~,,v,v:@d" commachar commaint i)
384           for s3 = (formatter-call-to-string fn commachar commaint i)
385           repeat 1000
386           unless (and
387                   (eql (elt s1 0) (elt s2 0))
388                   (eql (elt s1 1) (elt s2 1))
389                   (let ((len (length s2))
390                         (ci+1 (1+ commaint))
391                         (j 1))
392                     (loop for i from 2 below len
393                           always (if (= (mod (- len i) ci+1) 0)
394                                      (eql (elt s2 i) commachar)
395                                    (eql (elt s1 (incf j)) (elt s2 i))))))
396           collect (list x i commachar s1 s2 s3))))
397  nil)
398
399;;; NIL arguments
400
401(def-format-test format.d.14
402  "~vD" (nil 100) "100")
403
404(def-format-test format.d.15
405  "~6,vD" (nil 100) "   100")
406
407(def-format-test format.d.16
408  "~,,v:d" (nil 12345) "12,345")
409
410(def-format-test format.d.17
411  "~,,'*,v:d" (nil 12345) "12*345")
412
413;;; When the argument is not an integer, print as if using ~A and base 10
414
415(deftest format.d.18
416  (loop for x in *mini-universe*
417        for s1 = (format nil "~d" x)
418        for s2 = (format nil "~A" x)
419        unless (or (integerp x) (string= s1 s2))
420        collect (list x s1 s2))
421  nil)
422
423(deftest format.d.19
424  (loop for x in *mini-universe*
425        for s1 = (format nil "~:d" x)
426        for s2 = (format nil "~A" x)
427        unless (or (integerp x) (string= s1 s2))
428        collect (list x s1 s2))
429  nil)
430
431(deftest format.d.20
432  (loop for x in *mini-universe*
433        for s1 = (format nil "~@d" x)
434        for s2 = (format nil "~A" x)
435        unless (or (integerp x) (string= s1 s2))
436        collect (list x s1 s2))
437  nil)
438
439(deftest format.d.21
440  (loop for x in *mini-universe*
441        for s1 = (format nil "~A" x)
442        for s2 = (format nil "~@:d" x)
443        for s3 = (format nil "~A" x)
444        unless (or (integerp x) (string= s1 s2) (not (string= s1 s3)))
445        collect (list x s1 s2))
446  nil)
447
448;;; Must add tests for non-integers when the parameters
449;;; are specified, but it's not clear what the meaning is.
450;;; Does mincol apply to the ~A equivalent?  What about padchar?
451;;; Are comma-char and comma-interval always ignored?
452
453;;; # arguments
454
455(deftest format.d.22
456  (apply
457   #'values
458   (loop for i from 0 to 10
459         for args = (make-list i)
460         for s = (apply #'format nil "~#d" 12345 args)
461         collect s))
462  "12345"
463  "12345"
464  "12345"
465  "12345"
466  "12345"
467  " 12345"
468  "  12345"
469  "   12345"
470  "    12345"
471  "     12345"
472  "      12345")
473
474(deftest formatter.d.22
475  (apply
476   #'values
477   (let ((fn (formatter "~#D")))
478     (loop for i from 0 to 10
479           for args = (make-list i)
480           ; for s = (apply #'format nil "~#d" 12345 args)
481           for s = (with-output-to-string
482                     (stream)
483                     (assert (equal (apply fn stream 12345 args) args)))
484           collect s)))
485  "12345"
486  "12345"
487  "12345"
488  "12345"
489  "12345"
490  " 12345"
491  "  12345"
492  "   12345"
493  "    12345"
494  "     12345"
495  "      12345")
496
497(deftest format.d.23
498  (apply
499   #'values
500   (let ((fn (formatter "~,,,#:D")))
501     (loop for i from 0 to 10
502           for args = (make-list i)
503           for s = (apply #'format nil "~,,,#:d" 1234567890 args)
504           for s2 = (with-output-to-string
505                      (stream)
506                      (assert (equal (apply fn stream 1234567890 args) args)))
507           do (assert (string= s s2))
508           collect s)))
509  "1,2,3,4,5,6,7,8,9,0"
510  "12,34,56,78,90"
511  "1,234,567,890"
512  "12,3456,7890"
513  "12345,67890"
514  "1234,567890"
515  "123,4567890"
516  "12,34567890"
517  "1,234567890"
518  "1234567890"
519  "1234567890")
520
521(deftest format.d.24
522  (apply
523   #'values
524   (let ((fn (formatter "~,,,#:@d")))
525     (loop for i from 0 to 10
526           for args = (make-list i)
527           for s = (apply #'format nil "~,,,#@:D" 1234567890 args)
528           for s2 = (with-output-to-string
529                      (stream)
530                      (assert (equal (apply fn stream 1234567890 args) args)))
531           do (assert (string= s s2))
532           collect s)))
533  "+1,2,3,4,5,6,7,8,9,0"
534  "+12,34,56,78,90"
535  "+1,234,567,890"
536  "+12,3456,7890"
537  "+12345,67890"
538  "+1234,567890"
539  "+123,4567890"
540  "+12,34567890"
541  "+1,234567890"
542  "+1234567890"
543  "+1234567890")
544
545(def-format-test format.d.25
546  "~+10d" (1234) "      1234")
547
548(def-format-test format.d.26
549  "~+10@d" (1234) "     +1234")
550
551(def-format-test format.d.27
552  "~-1d" (1234) "1234")
553
554(def-format-test format.d.28
555  "~-1000000000000000000d" (1234) "1234")
556
557(def-format-test format.d.29
558  "~vd" ((1- most-negative-fixnum) 1234) "1234")
559
560;;; Randomized test
561
562(deftest format.d.30
563  (let ((fn (formatter "~v,v,v,vD")))
564    (loop
565     for mincol = (and (coin) (random 50))
566     for padchar = (and (coin)
567                        (random-from-seq +standard-chars+))
568     for commachar = (and (coin)
569                          (random-from-seq +standard-chars+))
570     for commaint = (and (coin) (1+ (random 10)))
571     for k = (ash 1 (+ 2 (random 30)))
572     for x = (- (random (+ k k)) k)
573     for fmt = (concatenate
574                'string
575                (if mincol (format nil "~~~d," mincol) "~,")
576                (if padchar (format nil "'~c," padchar) ",")
577                (if commachar (format nil "'~c," commachar) ",")
578                (if commaint (format nil "~dd" commaint) "d"))
579     for s1 = (format nil fmt x)
580     for s2 = (format nil "~v,v,v,vd" mincol padchar commachar commaint x)
581     for s3 = (formatter-call-to-string fn mincol padchar commachar commaint x)
582     repeat 2000
583     unless (and (string= s1 s2) (string= s2 s3))
584     collect (list mincol padchar commachar commaint fmt x s1 s2 s3)))
585  nil)
Note: See TracBrowser for help on using the repository browser.