format-d.lsp 20 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Jul 31 05:19:39 2004
;;;; Contains: Tests of the ~D format directive

(in-package :cl-test)

(compile-and-load "printer-aux.lsp")

(deftest format.d.1
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
13
14
15
16
17
18
19
20
21
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~D" i)
         for j = (read-from-string s1)
         repeat 1000
         when (or (/= i j)
                  (find #\. s1)
                  (find #\+ s1)
                  (find-if #'alpha-char-p s1))
         collect (list i s1 j)))
22
23
  nil)

24
25
26
27
(deftest formatter.d.1
  (let ((fn (formatter "~D")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
28
29
30
31
32
33
34
35
36
           for i = (- (random (+ x x)) x)
           for s1 = (formatter-call-to-string fn i)
           for j = (read-from-string s1)
           repeat 1000
           when (or (/= i j)
                    (find #\. s1)
                    (find #\+ s1)
                    (find-if #'alpha-char-p s1))
           collect (list i s1 j))))
37
38
  nil)

39
40
41
(deftest format.d.2
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
42
43
44
45
46
47
48
49
50
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@d" i)
         for j = (read-from-string s1)
         repeat 1000
         when (or (/= i j)
                  (find #\. s1)
                  ;; (find #\+ s1)
                  (find-if #'alpha-char-p s1))
         collect (list i s1 j)))
51
52
  nil)

53
54
55
56
(deftest formatter.d.2
  (let ((fn (formatter "~@D")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
57
58
59
60
61
62
63
64
65
           for i = (- (random (+ x x)) x)
           for s1 = (formatter-call-to-string fn i)
           for j = (read-from-string s1)
           repeat 1000
           when (or (/= i j)
                    (find #\. s1)
                    ;; (find #\+ s1)
                    (find-if #'alpha-char-p s1))
           collect (list i s1 j))))
66
67
  nil)

68
69
70
(deftest format.d.3
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
71
72
73
74
75
76
77
78
79
80
81
82
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~d" i)
         for s2 = (format nil (format nil "~~~dd" mincol) i)
         for pos = (search s1 s2)
         repeat 1000
         when (or (null pos)
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (not (eql (position #\Space s2 :test-not #'eql)
                                     (- (length s2) (length s1)))))))
         collect (list i mincol s1 s2 pos)))
83
84
  nil)

85
86
87
(deftest formatter.d.3
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~d" i)
         for format-string = (format nil "~~~dd" mincol)
         ; for s2 = (format nil format-string i)
         for fn = (eval `(formatter ,format-string))
         for s2 = (formatter-call-to-string fn i)
         for pos = (search s1 s2)
         repeat 100
         when (or (null pos)
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (not (eql (position #\Space s2 :test-not #'eql)
                                     (- (length s2) (length s1)))))))
         collect (list i mincol s1 s2 pos)))
103
104
  nil)

105
106
(deftest format.d.4
  (with-standard-io-syntax
107
   (loop with limit = 10
sds's avatar
sds committed
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
         with count = 0
         for x = (ash 1 (+ 2 (random 80)))
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@D" i)
         for format-string = (format nil "~~~d@d" mincol)
         for s2 = (format nil format-string i)
         for pos = (search s1 s2)
         repeat 1000
         when (or (null pos)
                  (and (>= i 0) (not (eql (elt s1 0) #\+)))
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (not (eql (position #\Space s2 :test-not #'eql)
                                     (- (length s2) (length s1)))))))
         collect (if (> (incf count) limit)
                     "Count limit exceeded"
                     (list i mincol s1 format-string s2 pos))
         while (<= count limit)))
127
128
  nil)

129
(deftest formatter.d.4
130
  (with-standard-io-syntax
131
   (loop with limit = 10
sds's avatar
sds committed
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
         with count = 0
         for x = (ash 1 (+ 2 (random 80)))
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@D" i)
         for format-string = (format nil "~~~d@d" mincol)
         for fn = (eval `(formatter ,format-string))
         for s2 = (formatter-call-to-string fn i)
         for pos = (search s1 s2)
         repeat 100
         when (or (null pos)
                  (and (>= i 0) (not (eql (elt s1 0) #\+)))
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (not (eql (position #\Space s2 :test-not #'eql)
                                     (- (length s2) (length s1)))))))
         collect (if (> (incf count) limit)
                     "Count limit exceeded"
                   (list i mincol s1 s2 pos))
         while (<= count limit)))
152
153
  nil)

154
(deftest format.d.5
155
156
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
157
158
159
160
161
162
163
164
165
166
167
168
169
         for mincol = (random 30)
         for padchar = (random-from-seq +standard-chars+)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~d" i)
         for s2 = (format nil (format nil "~~~d,'~cd" mincol padchar) i)
         for pos = (search s1 s2)
         repeat 1000
         when (or (null pos)
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (find padchar s2 :end (- (length s2) (length s1))
                                 :test-not #'eql))))
         collect (list i mincol s1 s2 pos)))
170
171
  nil)

172
(deftest formatter.d.5
173
174
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
         for mincol = (random 30)
         for padchar = (random-from-seq +standard-chars+)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~d" i)
         for format-string = (format nil "~~~d,'~cd" mincol padchar)
         for fn = (eval `(formatter ,format-string))
         for s2 = (formatter-call-to-string fn i)
         for pos = (search s1 s2)
         repeat 100
         when (or (null pos)
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (find padchar s2 :end (- (length s2) (length s1))
                                 :test-not #'eql))))
         collect (list i mincol s1 s2 pos)))
190
191
  nil)

192
193
194
195
(deftest format.d.6
  (let ((fn (formatter "~v,vd")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
           for mincol = (random 30)
           for padchar = (random-from-seq +standard-chars+)
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~d" i)
           for s2 = (format nil "~v,vD" mincol padchar i)
           for s3 = (formatter-call-to-string fn mincol padchar i)
           for pos = (search s1 s2)
           repeat 1000
           when (or (null pos)
                    (not (string= s2 s3))
                    (and (> mincol (length s1))
                         (or (/= (length s2) mincol)
                             (find padchar s2 :end (- (length s2) (length s1))
                                   :test-not #'eql))))
           collect (list i mincol s1 s2 s3 pos))))
211
212
213
214
215
  nil)

(deftest format.d.7
  (let ((fn (formatter "~v,v@D")))
    (with-standard-io-syntax
216
     (loop with limit = 10
sds's avatar
sds committed
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
           with count = 0
           for x = (ash 1 (+ 2 (random 80)))
           for mincol = (random 30)
           for padchar = (random-from-seq +standard-chars+)
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~@d" i)
           for s2 = (format nil "~v,v@d" mincol padchar i)
           for s3 = (formatter-call-to-string fn mincol padchar i)
           for pos = (search s1 s2)
           repeat 1000
           when (or (null pos)
                    (not (string= s2 s3))
                    (and (>= i 0) (not (eql (elt s1 0) #\+)))
                    (and (> mincol (length s1))
                         (or (/= (length s2) mincol)
                             (find padchar s2 :end (- (length s2) (length s1))
                                   :test-not #'eql))))
           collect (if (> (incf count) limit)
                       "Count limit exceeded"
                     (list i mincol s1 s2 s3 pos))
           while (<= count limit))))
238
239
  nil)

240
241
242
;;; Comma tests

(deftest format.d.8
243
  (let ((fn1 (formatter "~d"))
sds's avatar
sds committed
244
        (fn2 (formatter "~:d")))
245
    (loop for i from -999 to 999
sds's avatar
sds committed
246
247
248
249
250
251
          for s1 = (format nil "~d" i)
          for s2 = (format nil "~:d" i)
          for s3 = (formatter-call-to-string fn1 i)
          for s4 = (formatter-call-to-string fn2 i)
          unless (and (string= s1 s2) (string= s1 s3) (string= s1 s4))
          collect (list i s1 s2 s3 s4)))
252
253
254
  nil)

(deftest format.d.9
255
  (let ((fn1 (formatter "~d"))
sds's avatar
sds committed
256
        (fn2 (formatter "~:d")))
257
258
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
           for i = (- (random (+ x x)) x)
           for commachar = #\,
           for s1 = (format nil "~d" i)
           for s2 = (format nil "~:d" i)
           for s3 = (formatter-call-to-string fn1 i)
           for s4 = (formatter-call-to-string fn2 i)
           repeat 1000
           unless (and (string= s1 s3)
                       (string= s2 s4)
                       (string= s1 (remove commachar s2))
                       (not (eql (elt s2 0) commachar))
                       (or (>= i 0) (not (eql (elt s2 1) commachar)))
                       (let ((len (length s2))
                             (ci+1 4))
                         (loop for i from (if (< i 0) 2 1) below len
                               always (if (= (mod (- len i) ci+1) 0)
                                          (eql (elt s2 i) commachar)
                                        (find (elt s2 i) "0123456789")))))
           collect (list x i commachar s1 s2 s3 s4))))
278
279
280
  nil)

(deftest format.d.10
281
282
283
  (let ((fn (formatter "~,,v:d")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for s1 = (format nil "~d" i)
           for s2 = (format nil "~,,v:d" commachar i)
           for s3 = (formatter-call-to-string fn commachar i)
           repeat 1000
           unless (and
                   (string= s2 s3)
                   (eql (elt s1 0) (elt s2 0))
                   (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
                   (let ((len (length s2))
                         (ci+1 4)
                         (j (if (< i 0) 1 0)))
                     (loop for i from (if (< i 0) 2 1) below len
                           always (if (= (mod (- len i) ci+1) 0)
                                      (eql (elt s2 i) commachar)
                                    (eql (elt s1 (incf j)) (elt s2 i))))))
           collect (list x i commachar s1 s2 s3))))
302
303
304
  nil)

(deftest format.d.11
305
306
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
         for i = (- (random (+ x x)) x)
         for commachar = (random-from-seq +standard-chars+)
         for s1 = (format nil "~d" i)
         for format-string = (format nil "~~,,'~c:d" commachar)
         for s2 = (format nil format-string i)
         repeat 1000
         unless (and
                 (eql (elt s1 0) (elt s2 0))
                 (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
                 (let ((len (length s2))
                      (ci+1 4)
                      (j (if (< i 0) 1 0)))
                  (loop for i from (if (< i 0) 2 1) below len
                        always (if (= (mod (- len i) ci+1) 0)
                                   (eql (elt s2 i) commachar)
                                 (eql (elt s1 (incf j)) (elt s2 i))))))
         collect (list x i commachar s1 s2)))
324
325
  nil)

326
(deftest formatter.d.11
327
328
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
         for i = (- (random (+ x x)) x)
         for commachar = (random-from-seq +standard-chars+)
         for s1 = (format nil "~d" i)
         for format-string = (format nil "~~,,'~c:d" commachar)
         for fn = (eval `(formatter ,format-string))
         ; for s2 = (format nil format-string i)
         for s2 = (formatter-call-to-string fn i)
         repeat 100
         unless (and
                 (eql (elt s1 0) (elt s2 0))
                 (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
                 (let ((len (length s2))
                      (ci+1 4)
                      (j (if (< i 0) 1 0)))
                  (loop for i from (if (< i 0) 2 1) below len
                        always (if (= (mod (- len i) ci+1) 0)
                                   (eql (elt s2 i) commachar)
                                 (eql (elt s1 (incf j)) (elt s2 i))))))
         collect (list x i commachar s1 s2)))
348
349
350
  nil)

(deftest format.d.12
351
352
353
  (let ((fn (formatter "~,,v,v:d")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for commaint = (1+ (random 20))
           for s1 = (format nil "~d" i)
           for s2 = (format nil "~,,v,v:D" commachar commaint i)
           for s3 = (formatter-call-to-string fn commachar commaint i)
           repeat 1000
           unless (and
                   (string= s2 s3)
                   (eql (elt s1 0) (elt s2 0))
                   (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
                   (let ((len (length s2))
                         (ci+1 (1+ commaint))
                         (j (if (< i 0) 1 0)))
                     (loop for i from (if (< i 0) 2 1) below len
                           always (if (= (mod (- len i) ci+1) 0)
                                      (eql (elt s2 i) commachar)
                                    (eql (elt s1 (incf j)) (elt s2 i))))))
           collect (list x i commachar s1 s2 s3))))
373
374
375
  nil)

(deftest format.d.13
376
377
378
  (let ((fn (formatter "~,,v,v:@D")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for commaint = (1+ (random 20))
           for s1 = (format nil "~@d" i)
           for s2 = (format nil "~,,v,v:@d" commachar commaint i)
           for s3 = (formatter-call-to-string fn commachar commaint i)
           repeat 1000
           unless (and
                   (eql (elt s1 0) (elt s2 0))
                   (eql (elt s1 1) (elt s2 1))
                   (let ((len (length s2))
                         (ci+1 (1+ commaint))
                         (j 1))
                     (loop for i from 2 below len
                           always (if (= (mod (- len i) ci+1) 0)
                                      (eql (elt s2 i) commachar)
                                    (eql (elt s1 (incf j)) (elt s2 i))))))
           collect (list x i commachar s1 s2 s3))))
397
398
399
400
  nil)

;;; NIL arguments

401
402
(def-format-test format.d.14
  "~vD" (nil 100) "100")
403

404
405
(def-format-test format.d.15
  "~6,vD" (nil 100) "   100")
406

407
408
(def-format-test format.d.16
  "~,,v:d" (nil 12345) "12,345")
409

410
411
(def-format-test format.d.17
  "~,,'*,v:d" (nil 12345) "12*345")
412
413
414
415
416

;;; When the argument is not an integer, print as if using ~A and base 10

(deftest format.d.18
  (loop for x in *mini-universe*
sds's avatar
sds committed
417
418
419
420
        for s1 = (format nil "~d" x)
        for s2 = (format nil "~A" x)
        unless (or (integerp x) (string= s1 s2))
        collect (list x s1 s2))
421
422
423
424
  nil)

(deftest format.d.19
  (loop for x in *mini-universe*
sds's avatar
sds committed
425
426
427
428
        for s1 = (format nil "~:d" x)
        for s2 = (format nil "~A" x)
        unless (or (integerp x) (string= s1 s2))
        collect (list x s1 s2))
429
430
431
432
  nil)

(deftest format.d.20
  (loop for x in *mini-universe*
sds's avatar
sds committed
433
434
435
436
        for s1 = (format nil "~@d" x)
        for s2 = (format nil "~A" x)
        unless (or (integerp x) (string= s1 s2))
        collect (list x s1 s2))
437
438
439
440
  nil)

(deftest format.d.21
  (loop for x in *mini-universe*
sds's avatar
sds committed
441
442
        for s1 = (format nil "~A" x)
        for s2 = (format nil "~@:d" x)
443
        for s3 = (format nil "~A" x)
sds's avatar
sds committed
444
445
        unless (or (integerp x) (string= s1 s2) (not (string= s1 s3)))
        collect (list x s1 s2))
446
447
448
449
450
451
452
453
454
455
456
457
458
  nil)

;;; Must add tests for non-integers when the parameters
;;; are specified, but it's not clear what the meaning is.
;;; Does mincol apply to the ~A equivalent?  What about padchar?
;;; Are comma-char and comma-interval always ignored?

;;; # arguments

(deftest format.d.22
  (apply
   #'values
   (loop for i from 0 to 10
sds's avatar
sds committed
459
460
461
         for args = (make-list i)
         for s = (apply #'format nil "~#d" 12345 args)
         collect s))
462
463
464
465
466
467
468
469
470
471
472
473
  "12345"
  "12345"
  "12345"
  "12345"
  "12345"
  " 12345"
  "  12345"
  "   12345"
  "    12345"
  "     12345"
  "      12345")

474
475
476
477
478
(deftest formatter.d.22
  (apply
   #'values
   (let ((fn (formatter "~#D")))
     (loop for i from 0 to 10
sds's avatar
sds committed
479
480
481
482
483
484
           for args = (make-list i)
           ; for s = (apply #'format nil "~#d" 12345 args)
           for s = (with-output-to-string
                     (stream)
                     (assert (equal (apply fn stream 12345 args) args)))
           collect s)))
485
486
487
488
489
490
491
492
493
494
495
496
  "12345"
  "12345"
  "12345"
  "12345"
  "12345"
  " 12345"
  "  12345"
  "   12345"
  "    12345"
  "     12345"
  "      12345")

497
498
499
(deftest format.d.23
  (apply
   #'values
500
501
   (let ((fn (formatter "~,,,#:D")))
     (loop for i from 0 to 10
sds's avatar
sds committed
502
503
504
505
506
507
508
           for args = (make-list i)
           for s = (apply #'format nil "~,,,#:d" 1234567890 args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream 1234567890 args) args)))
           do (assert (string= s s2))
           collect s)))
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
  "1,2,3,4,5,6,7,8,9,0"
  "12,34,56,78,90"
  "1,234,567,890"
  "12,3456,7890"
  "12345,67890"
  "1234,567890"
  "123,4567890"
  "12,34567890"
  "1,234567890"
  "1234567890"
  "1234567890")

(deftest format.d.24
  (apply
   #'values
524
525
   (let ((fn (formatter "~,,,#:@d")))
     (loop for i from 0 to 10
sds's avatar
sds committed
526
527
528
529
530
531
532
           for args = (make-list i)
           for s = (apply #'format nil "~,,,#@:D" 1234567890 args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream 1234567890 args) args)))
           do (assert (string= s s2))
           collect s)))
533
534
535
536
537
538
539
540
541
542
543
544
  "+1,2,3,4,5,6,7,8,9,0"
  "+12,34,56,78,90"
  "+1,234,567,890"
  "+12,3456,7890"
  "+12345,67890"
  "+1234,567890"
  "+123,4567890"
  "+12,34567890"
  "+1,234567890"
  "+1234567890"
  "+1234567890")

545
546
(def-format-test format.d.25
  "~+10d" (1234) "      1234")
547

548
549
(def-format-test format.d.26
  "~+10@d" (1234) "     +1234")
550

551
552
(def-format-test format.d.27
  "~-1d" (1234) "1234")
553

554
555
(def-format-test format.d.28
  "~-1000000000000000000d" (1234) "1234")
556

557
558
(def-format-test format.d.29
  "~vd" ((1- most-negative-fixnum) 1234) "1234")
559
560
561
562

;;; Randomized test

(deftest format.d.30
563
564
565
566
  (let ((fn (formatter "~v,v,v,vD")))
    (loop
     for mincol = (and (coin) (random 50))
     for padchar = (and (coin)
sds's avatar
sds committed
567
                        (random-from-seq +standard-chars+))
568
     for commachar = (and (coin)
sds's avatar
sds committed
569
                          (random-from-seq +standard-chars+))
570
571
572
573
     for commaint = (and (coin) (1+ (random 10)))
     for k = (ash 1 (+ 2 (random 30)))
     for x = (- (random (+ k k)) k)
     for fmt = (concatenate
sds's avatar
sds committed
574
575
576
577
578
                'string
                (if mincol (format nil "~~~d," mincol) "~,")
                (if padchar (format nil "'~c," padchar) ",")
                (if commachar (format nil "'~c," commachar) ",")
                (if commaint (format nil "~dd" commaint) "d"))
579
580
581
582
583
584
     for s1 = (format nil fmt x)
     for s2 = (format nil "~v,v,v,vd" mincol padchar commachar commaint x)
     for s3 = (formatter-call-to-string fn mincol padchar commachar commaint x)
     repeat 2000
     unless (and (string= s1 s2) (string= s2 s3))
     collect (list mincol padchar commachar commaint fmt x s1 s2 s3)))
585
  nil)