source: trunk/source/tests/ansi-tests/format-f.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: 16.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Aug  1 07:14:17 2004
4;;;; Contains: Tests of the ~f format directive
5
6(in-package :cl-test)
7
8(compile-and-load "printer-aux.lsp")
9
10;;; Equivalent to PRIN1 for 0 or (abs x) in range [10^-3,10^7).
11
12(deftest format.f.1
13  (let ((*print-readably* nil)
14        (fn (formatter "~F")))
15    (loop
16     for type in '(short-float single-float double-float long-float
17                   short-float single-float double-float long-float)
18     for x in '(0.0s0 0.0f0 0.0d0 0.0l0
19                      -0.0s0 -0.0f0 -0.0d0 -0.0l0)
20     for s1 = (let ((*read-default-float-format* type)) (format nil "~f" x))
21     for s2 = (let ((*read-default-float-format* type)) (prin1-to-string x))
22     for s3 = (let ((*read-default-float-format* type))
23                (formatter-call-to-string fn x))
24     unless (and (string= s1 s2) (string= s1 s3))
25     collect (list x type s1 s2 s3)))
26  nil)
27
28(deftest format.f.2
29  (let ((*print-readably* nil)
30        (fn (formatter "~f")))
31    (loop
32     for i = (random 4)
33     for type = (elt #(short-float single-float double-float long-float) i)
34     for x = (expt (coerce 10 type)
35                   (- (random 10.0s0) 3))
36     for s1 = (let ((*read-default-float-format* type)) (format nil "~f" x))
37     for s2 = (let ((*read-default-float-format* type)) (prin1-to-string x))
38     for s3 = (let ((*read-default-float-format* type))
39                (formatter-call-to-string fn x))
40     repeat 1000
41     when (and (<= 1/1000 x)
42               (< x 10000000)
43               (or (not (string= s1 s2))
44                   (not (string= s1 s3))))
45     collect (list x s1 s2 s3)))
46  nil)
47
48(deftest format.f.3
49  (let ((*print-readably* nil)
50        (fn (formatter "~F")))
51    (loop
52     for i = (random 4)
53     for type = (elt #(short-float single-float double-float long-float) i)
54     for x = (- (expt (coerce 10 type)
55                      (- (random 10.0s0) 3)))
56     for s1 = (let ((*read-default-float-format* type)) (format nil "~f" x))
57     for s2 = (let ((*read-default-float-format* type)) (prin1-to-string x))
58     for s3 = (let ((*read-default-float-format* type))
59                (formatter-call-to-string fn x))
60     repeat 1000
61     when (and (>= -1/1000 x)
62               (> x -10000000)
63               (not (and (string= s1 s2) (string= s1 s3))))
64     collect (list x s1 s2 s3)))
65  nil)
66
67(deftest format.f.4
68  (let ((fn (formatter "~3f")))
69    (loop for x in (remove-duplicates '(1 1.0s0 1.0f0 1.0d0 1.0l0))
70          for s = (format nil "~3f" x)
71          for s2 = (formatter-call-to-string fn x)
72          unless (and (string= s "1.0") (string= s s2))
73          collect (list x s s2)))
74  nil)
75
76(deftest format.f.5
77  (let ((fn (formatter "~2f")))
78    (loop for x in (remove-duplicates '(1 1.0s0 1.0f0 1.0d0 1.0l0))
79          for s = (format nil "~2f" x)
80          for s2 = (formatter-call-to-string fn x)
81          unless (and (string= s "1.") (string= s s2))
82          collect (list x s s2)))
83  nil)
84
85(deftest format.f.6
86  (let ((fn (formatter "~4F")))
87    (loop for x in (remove-duplicates '(1 1.0s0 1.0f0 1.0d0 1.0l0))
88          for s = (format nil "~4F" x)
89          for s2 = (formatter-call-to-string fn x)
90          unless (and (string= s " 1.0") (string= s s2))
91          collect (list x s s2)))
92  nil)
93
94(deftest format.f.7
95  (let ((fn (formatter "~4@F")))
96    (loop for x in (remove-duplicates '(1 1.0s0 1.0f0 1.0d0 1.0l0))
97          for s = (format nil "~4@f" x)
98          for s2 = (formatter-call-to-string fn x)
99          unless (and (string= s "+1.0") (string= s s2))
100          collect (list x s s2)))
101  nil)
102
103(deftest format.f.8
104  (let ((fn (formatter "~3@F")))
105    (loop for x in (remove-duplicates '(1 1.0s0 1.0f0 1.0d0 1.0l0))
106          for s = (format nil "~3@F" x)
107          for s2 = (formatter-call-to-string fn x)
108          unless (and (string= s "+1.") (string= s s2))
109          collect (list x s s2)))
110  nil)
111
112(deftest format.f.9
113  (let ((fn (formatter "~4f")))
114    (loop for x in (remove-duplicates '(1 1.0s0 1.0f0 1.0d0 1.0l0))
115          for s = (format nil "~4f" (- x))
116          for s2 = (formatter-call-to-string fn (- x))
117          unless (and (string= s "-1.0") (string= s s2))
118          collect (list (- x) s s2)))
119  nil)
120
121(deftest format.f.10
122  (let ((fn (formatter "~3F")))
123    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
124          for s = (format nil "~3f" x)
125          for s2 = (formatter-call-to-string fn x)
126          unless (and (string= s "0.5") (string= s s2))
127          collect (list x s s2)))
128  nil)
129
130(deftest format.f.11
131  (let ((fn (formatter "~4f")))
132    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
133          for s = (format nil "~4f" x)
134          for s2 = (formatter-call-to-string fn x)
135          unless (and (string= s " 0.5") (string= s s2))
136          collect (list x s s2)))
137  nil)
138
139(deftest format.f.12
140  (let ((fn (formatter "~4,2F")))
141    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
142          for s = (format nil "~4,2f" x)
143          for s2 = (formatter-call-to-string fn x)
144          unless (and (string= s "0.50") (string= s s2))
145          collect (list x s s2)))
146  nil)
147
148(deftest format.f.13
149  (let ((fn (formatter "~3,2F")))
150    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
151          for s = (format nil "~3,2f" x)
152          for s2 = (formatter-call-to-string fn x)
153          unless (and (string= s ".50") (string= s s2))
154          collect (list x s s2)))
155  nil)
156
157(deftest format.f.14
158  (let ((fn (formatter "~2,1F")))
159    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
160          for s = (format nil "~2,1f" x)
161          for s2 = (formatter-call-to-string fn x)
162          unless (and (string= s ".5") (string= s s2))
163          collect (list x s s2)))
164  nil)
165
166(deftest format.f.15
167  (let ((fn (formatter "~4,2@F")))
168    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
169          for s = (format nil "~4,2@f" x)
170          for s2 = (formatter-call-to-string fn x)
171          unless (and (string= s "+.50") (string= s s2))
172          collect (list x s s2)))
173  nil)
174
175(deftest format.f.16
176  (let ((fn (formatter "~2,2F")))
177    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
178          for s = (format nil "~2,2f" x)
179          for s2 = (formatter-call-to-string fn x)
180          unless (and (string= s ".50") (string= s s2))
181          collect (list x s s2)))
182  nil)
183
184(deftest format.f.17
185  (let ((fn (formatter "~,2F")))
186    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
187          for s = (format nil "~,2f" x)
188          for s2 = (formatter-call-to-string fn x)
189          unless (and (string= s "0.50") (string= s s2))
190          collect (list x s s2)))
191  nil)
192
193(deftest format.f.18
194  (let ((fn (formatter "~,2F")))
195    (loop for xn in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
196          for x = (- xn)
197          for s = (format nil "~,2f" x)
198          for s2 = (formatter-call-to-string fn x)
199          unless (and (string= s "-0.50") (string= s s2))
200          collect (list x s s2)))
201  nil)
202
203(deftest format.f.19
204  (let ((fn (formatter "~4,2,-1F")))
205    (loop for x in (remove-duplicates '(5 5.0s0 5.0f0 5.0d0 5.0l0))
206          for s = (format nil "~4,2,-1f" x)
207          for s2 = (formatter-call-to-string fn x)
208          unless (and (string= s "0.50") (string= s s2))
209          collect (list x s s2)))
210  nil)
211
212(deftest format.f.20
213  (let ((fn (formatter "~4,2,0F")))
214    (loop for x in (remove-duplicates '(1/2 0.5s0 0.5f0 0.5d0 0.5l0))
215          for s = (format nil "~4,2,0f" x)
216          for s2 = (formatter-call-to-string fn x)
217          unless (and (string= s "0.50") (string= s s2))
218          collect (list x s s2)))
219  nil)
220
221(deftest format.f.21
222  (let ((fn (formatter "~4,2,1f")))
223    (loop for x in (remove-duplicates '(1/20 0.05s0 0.05f0 0.05d0 0.05l0))
224          for s = (format nil "~4,2,1f" x)
225          for s2 = (formatter-call-to-string fn x)
226          unless (and (string= s "0.50") (string= s s2))
227          collect (list x s s2)))
228  nil)
229
230;;; overflow
231
232(deftest format.f.22
233  (let ((fn (formatter "~5,1,,'*F")))
234    (loop for x in (remove-duplicates
235                    '(1000 1000.0s0 1000.0f0 1000.0d0 1000.0l0))
236          for s = (format nil "~5,1,,'*f" x)
237          for s2 = (formatter-call-to-string fn x)
238          unless (and (string= s "*****") (string= s s2))
239          collect (list x s s2)))
240  nil)
241
242(deftest format.f.23
243  (let ((fn (formatter "~5,1,,'*f")))
244    (loop for x in (remove-duplicates
245                    '(100 100.0s0 100.0f0 100.0d0 100.0l0))
246          for s = (format nil "~5,1,,'*f" x)
247          for s2 = (formatter-call-to-string fn x)
248          unless (and (string= s "100.0") (string= s s2))
249          collect (list x s s2)))
250  nil)
251
252(deftest format.f.24
253  (let ((fn (formatter "~4,0,,'*F")))
254    (loop for x in (remove-duplicates
255                    '(100 100.0s0 100.0f0 100.0d0 100.0l0))
256          for s = (format nil "~4,0,,'*f" x)
257          for s2 = (formatter-call-to-string fn x)
258          unless (and (string= s "100.") (string= s s2))
259          collect (list x s s2)))
260  nil)
261
262(deftest format.f.25
263  (let ((fn (formatter "~1,1,,f")))
264    (loop for x in (remove-duplicates
265                    '(100 100.0s0 100.0f0 100.0d0 100.0l0))
266          for s = (format nil "~1,1,,f" x)
267          for s2 = (formatter-call-to-string fn x)
268          unless (and (string= s "100.0") (string= s s2))
269          collect (list x s s2)))
270  nil)
271
272;;; padchar
273
274(deftest format.f.26
275  (let ((fn (formatter "~10,1,,f")))
276    (loop for x in (remove-duplicates
277                    '(100 100.0s0 100.0f0 100.0d0 100.0l0))
278          for s = (format nil "~10,1,,f" x)
279          for s2 = (formatter-call-to-string fn x)
280          unless (and (string= s "     100.0") (string= s s2))
281          collect (list x s s2)))
282  nil)
283
284(deftest format.f.27
285  (let ((fn (formatter "~10,1,,,'*F")))
286    (loop for x in (remove-duplicates
287                    '(100 100.0s0 100.0f0 100.0d0 100.0l0))
288          for s = (format nil "~10,1,,,'*f" x)
289          for s2 = (formatter-call-to-string fn x)
290          unless (and (string= s "*****100.0") (string= s s2))
291          collect (list x s s2)))
292  nil)
293
294;;; v parameters
295
296(deftest format.f.28
297  (let ((fn (formatter "~VF")))
298    (loop for x = (random 100.0)
299          for s1 = (format nil "~f" x)
300          for s2 = (format nil "~vf" nil x)
301          for s3 = (formatter-call-to-string fn nil x)
302          repeat 100
303          unless (and (string= s1 s2) (string= s2 s3))
304          collect (list x s1 s2 s3)))
305  nil)
306
307(deftest format.f.29
308  (let ((fn (formatter "~,vf")))
309    (loop for x = (random 100.0)
310          for s1 = (format nil "~f" x)
311          for s2 = (format nil "~,vf" nil x)
312          for s3 = (formatter-call-to-string fn nil x)
313          repeat 100
314          unless (and (string= s1 s2) (string= s2 s3))
315          collect (list x s1 s2 s3)))
316  nil)
317
318(deftest format.f.30
319  (let ((fn (formatter "~,,Vf")))
320    (loop for x = (random 100.0)
321          for s1 = (format nil "~f" x)
322          for s2 = (format nil "~,,vf" nil x)
323          for s3 = (formatter-call-to-string fn nil x)
324          repeat 100
325          unless (and (string= s1 s2) (string= s2 s3))
326          collect (list x s1 s2 s3)))
327  nil)
328
329(deftest format.f.31
330  (let ((fn (formatter "~,,,vF")))
331    (loop for x = (random 100.0)
332          for s1 = (format nil "~f" x)
333          for s2 = (format nil "~,,,vf" nil x)
334          for s3 = (formatter-call-to-string fn nil x)
335          repeat 100
336          unless (and (string= s1 s2) (string= s2 s3))
337          collect (list x s1 s2 s3)))
338  nil)
339
340(deftest format.f.32
341  (let ((fn (formatter "~,,,,VF")))
342    (loop for x = (random 100.0)
343          for s1 = (format nil "~f" x)
344          for s2 = (format nil "~,,,,vf" nil x)
345          for s3 = (formatter-call-to-string fn nil x)
346          repeat 100
347          unless (and (string= s1 s2) (string= s2 s3))
348          collect (list x s1 s2 s3)))
349  nil)
350
351;;; Randomized tests
352
353#|
354(deftest format.f.33
355  (let ((bound (if (> 10000000 most-positive-short-float)
356                   most-positive-short-float
357                 (coerce 10000000 'short-float))))
358    (loop for d = (random 10)
359          for w = (+ 1 d (random 10))
360          for x = (random bound)
361          for xr = (rational x)
362          for s = (format nil "~v,vf" w d x)
363          for sr = (decode-fixed-decimal-string s)
364          for eps = (expt 1/10 d)
365          for abs-xr-sr = (abs (- xr sr))
366          for abs-xr-sr-hi = (abs (- xr (+ sr eps)))
367          for abs-xr-sr-lo = (abs (- xr (- sr eps)))
368          repeat 100
369          unless (and (<= abs-xr-sr abs-xr-sr-hi)
370                      (<= abs-xr-sr abs-xr-sr-lo))
371          collect (list d w x xr s sr eps abs-xr-sr abs-xr-sr-hi abs-xr-sr-lo)))
372  nil)
373|#
374
375(deftest format.f.34
376  (with-standard-io-syntax
377   (let ((*read-default-float-format* 'short-float))
378     (loop for i from (- 1 (ash 1 13)) below (ash 1 13)
379           for sf = (coerce i 'short-float)
380           for s = (format nil "~f" sf)
381           for i2 = (floor (read-from-string s))
382           unless (or (zerop i) (eql i i2))
383           collect (list i sf s i2))))
384  nil)
385
386(deftest format.f.35
387  (with-standard-io-syntax
388   (let ((*read-default-float-format* 'single-float))
389     (loop for i = (- (random (1- (ash 1 25))) -1 (ash 1 24))
390           for sf = (coerce i 'single-float)
391           for s = (format nil "~f" sf)
392           for i2 = (floor (read-from-string s))
393           repeat 2000
394           unless (or (zerop i) (eql i i2))
395           collect (list i sf s i2))))
396  nil)
397
398(deftest format.f.36
399  (with-standard-io-syntax
400   (let ((*read-default-float-format* 'double-float))
401     (loop for i = (- (random (1- (ash 1 51))) -1 (ash 1 50))
402           for sf = (coerce i 'double-float)
403           for s = (format nil "~f" sf)
404           for i2 = (floor (read-from-string s))
405           repeat 2000
406           unless (or (zerop i) (eql i i2))
407           collect (list i sf s i2))))
408  nil)
409
410(deftest format.f.37
411  (with-standard-io-syntax
412   (let ((*read-default-float-format* 'long-float))
413     (loop for i = (- (random (1- (ash 1 51))) -1 (ash 1 50))
414           for sf = (coerce i 'long-float)
415           for s = (format nil "~f" sf)
416           for i2 = (floor (read-from-string s))
417           repeat 2000
418           unless (or (zerop i) (eql i i2))
419           collect (list i sf s i2))))
420  nil)
421
422(deftest format.f.38
423  (funcall
424   (compile
425    nil
426    '(lambda ()
427       (with-standard-io-syntax
428        (let ((*read-default-float-format* 'short-float)
429              (total 0)
430              (len 0))
431          (loop for i from (- 1 (ash 1 13)) below (ash 1 13)
432                unless (zerop i)
433                nconc
434                (loop for sf = (coerce i 'short-float)
435                      for w = (random 8)
436                      for d = (random 4)
437                      for s = (format nil "~v,vf" w d sf)
438                      for i2 = (ignore-errors (floor (read-from-string s)))
439                      repeat 5
440                      ; do (print (list w d s i i2))
441                      unless (eql i i2)
442                      do (incf total)
443                      and collect (list i sf w d s i2))
444                when (> total 100) collect "count limit exceeded"
445                and do (loop-finish)))))))
446  nil)
447
448(deftest format.f.39
449  (with-standard-io-syntax
450   (let ((*read-default-float-format* 'single-float))
451     (loop for i = (- (random (1- (ash 1 25))) -1 (ash 1 24))
452           for sf = (coerce i 'single-float)
453           for w = (and (coin) (random 16))
454           for d = (random 4)
455           for s = (format nil "~v,vf" w d sf)
456           for i2 = (floor (read-from-string s))
457           repeat 2000
458           unless (or (zerop i) (eql i i2))
459           collect (list i sf w d s i2))))
460  nil)
461
462(deftest format.f.40
463  (with-standard-io-syntax
464   (let ((*read-default-float-format* 'double-float))
465     (loop for i = (- (random (1- (ash 1 51))) -1 (ash 1 50))
466           for sf = (coerce i 'double-float)
467           for w = (and (coin) (random 30))
468           for d = (random 6)
469           for s = (format nil "~v,vf" w d sf)
470           for i2 = (floor (read-from-string s))
471           repeat 2000
472           unless (or (zerop i) (eql i i2))
473           collect (list i sf w d s i2))))
474  nil)
475
476(deftest format.f.41
477  (with-standard-io-syntax
478   (let ((*read-default-float-format* 'long-float))
479     (loop for i = (- (random (1- (ash 1 51))) -1 (ash 1 50))
480           for sf = (coerce i 'long-float)
481           for w = (and (coin) (random 30))
482           for d = (random 6)
483           for s = (format nil "~v,vf" w d sf)
484           for i2 = (floor (read-from-string s))
485           repeat 2000
486           unless (or (zerop i) (eql i i2))
487           collect (list i sf w d s i2))))
488  nil)
489
490(deftest format.f.42
491  (let ((chars +standard-chars+))
492    (loop
493     for k = (and (coin) (random 6))
494     for x = (random (/ (random-from-seq #(#.(coerce (* 32 (1- (ash 1 13))) 'short-float)
495                                             #.(coerce (* 256 (1- (ash 1 24))) 'single-float)
496                                             #.(coerce (* 256 (1- (ash 1 50))) 'double-float)
497                                             #.(coerce (* 256 (1- (ash 1 50))) 'long-float)))
498                        (if k (expt 10 k) 1)))
499     for w = (and (coin) (random 30))
500     for d = (and (coin) (random 10))
501     for overflowchar = (and (coin) (random-from-seq chars))
502     for padchar = (and (coin) (random-from-seq chars))
503     for f1 = (concatenate 'string
504                           "~"
505                           (if w (format nil "~d" w) "")
506                           ","
507                           (if d (format nil "~d" d) "")
508                           ","
509                           (if k (format nil "~d" k) "")
510                           ","
511                           (if overflowchar (format nil "'~c" overflowchar) "")
512                           ","
513                           (if padchar (format nil "'~c" padchar) "")
514                           (string (random-from-seq "fF")))
515     for s1 = (format nil f1 x)
516     for s2 = (format nil "~v,v,v,v,vf" w d k overflowchar padchar x)
517     repeat 2000
518     unless (string= s1 s2)
519     collect (list x w d k overflowchar padchar f1 s1 s2)))
520  nil)
521
522;;; This failed in sbcl 0.8.12.25
523
524(def-format-test format.f.43
525  "~,,,,',f" (0.0) "0.0")
526
527(deftest format.f.44
528  (loop for i from 0 below (min #x10000 char-code-limit)
529        for x = 2312.9817
530        for c = (code-char i)
531        for f1 = (and c (format nil "~~,,,,'~cf" c))
532        for s1 = (and c (ignore-errors (format nil f1 x)))
533        for s2 = (and c (format nil "~,,,,vf" c x))
534        unless (equal s1 s2)
535        collect (list i c f1 s1 s2))
536  nil)
Note: See TracBrowser for help on using the repository browser.