source: trunk/tests/ansi-tests/format-f.lsp @ 14368

Last change on this file since 14368 was 14368, checked in by gz, 10 years ago

Don't muffle warnings when running test, as that affects the return values from compile-file. Tweak tests to not cause warnings

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          total len
432          (loop for i from (- 1 (ash 1 13)) below (ash 1 13)
433                unless (zerop i)
434                nconc
435                (loop for sf = (coerce i 'short-float)
436                      for w = (random 8)
437                      for d = (random 4)
438                      for s = (format nil "~v,vf" w d sf)
439                      for i2 = (ignore-errors (floor (read-from-string s)))
440                      repeat 5
441                      ; do (print (list w d s i i2))
442                      unless (eql i i2)
443                      do (incf total)
444                      and collect (list i sf w d s i2))
445                when (> total 100) collect "count limit exceeded"
446                and do (loop-finish)))))))
447  nil)
448
449(deftest format.f.39
450  (with-standard-io-syntax
451   (let ((*read-default-float-format* 'single-float))
452     (loop for i = (- (random (1- (ash 1 25))) -1 (ash 1 24))
453           for sf = (coerce i 'single-float)
454           for w = (and (coin) (random 16))
455           for d = (random 4)
456           for s = (format nil "~v,vf" w d sf)
457           for i2 = (floor (read-from-string s))
458           repeat 2000
459           unless (or (zerop i) (eql i i2))
460           collect (list i sf w d s i2))))
461  nil)
462
463(deftest format.f.40
464  (with-standard-io-syntax
465   (let ((*read-default-float-format* 'double-float))
466     (loop for i = (- (random (1- (ash 1 51))) -1 (ash 1 50))
467           for sf = (coerce i 'double-float)
468           for w = (and (coin) (random 30))
469           for d = (random 6)
470           for s = (format nil "~v,vf" w d sf)
471           for i2 = (floor (read-from-string s))
472           repeat 2000
473           unless (or (zerop i) (eql i i2))
474           collect (list i sf w d s i2))))
475  nil)
476
477(deftest format.f.41
478  (with-standard-io-syntax
479   (let ((*read-default-float-format* 'long-float))
480     (loop for i = (- (random (1- (ash 1 51))) -1 (ash 1 50))
481           for sf = (coerce i 'long-float)
482           for w = (and (coin) (random 30))
483           for d = (random 6)
484           for s = (format nil "~v,vf" w d sf)
485           for i2 = (floor (read-from-string s))
486           repeat 2000
487           unless (or (zerop i) (eql i i2))
488           collect (list i sf w d s i2))))
489  nil)
490
491(deftest format.f.42
492  (let ((chars +standard-chars+))
493    (loop
494     for k = (and (coin) (random 6))
495     for x = (random (/ (random-from-seq #(#.(coerce (* 32 (1- (ash 1 13))) 'short-float)
496                                             #.(coerce (* 256 (1- (ash 1 24))) 'single-float)
497                                             #.(coerce (* 256 (1- (ash 1 50))) 'double-float)
498                                             #.(coerce (* 256 (1- (ash 1 50))) 'long-float)))
499                        (if k (expt 10 k) 1)))
500     for w = (and (coin) (random 30))
501     for d = (and (coin) (random 10))
502     for overflowchar = (and (coin) (random-from-seq chars))
503     for padchar = (and (coin) (random-from-seq chars))
504     for f1 = (concatenate 'string
505                           "~"
506                           (if w (format nil "~d" w) "")
507                           ","
508                           (if d (format nil "~d" d) "")
509                           ","
510                           (if k (format nil "~d" k) "")
511                           ","
512                           (if overflowchar (format nil "'~c" overflowchar) "")
513                           ","
514                           (if padchar (format nil "'~c" padchar) "")
515                           (string (random-from-seq "fF")))
516     for s1 = (format nil f1 x)
517     for s2 = (format nil "~v,v,v,v,vf" w d k overflowchar padchar x)
518     repeat 2000
519     unless (string= s1 s2)
520     collect (list x w d k overflowchar padchar f1 s1 s2)))
521  nil)
522
523;;; This failed in sbcl 0.8.12.25
524
525(def-format-test format.f.43
526  "~,,,,',f" (0.0) "0.0")
527
528(deftest format.f.44
529  (loop for i from 0 below (min #x10000 char-code-limit)
530        for x = 2312.9817
531        for c = (code-char i)
532        for f1 = (and c (format nil "~~,,,,'~cf" c))
533        for s1 = (and c (ignore-errors (format nil f1 x)))
534        for s2 = (and c (format nil "~,,,,vf" c x))
535        unless (equal s1 s2)
536        collect (list i c f1 s1 s2))
537  nil)
Note: See TracBrowser for help on using the repository browser.