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