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