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