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

Last change on this file since 14368 was 14368, checked in by gz, 9 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.