source: trunk/tests/ansi-tests/print-floats.lsp @ 15403

Last change on this file since 15403 was 15403, checked in by gb, 8 years ago

PRINT.*-FLOAT.4 has the same bug as PRINT.*-FLOAT.2 (when i = -10000000,
(float i) should and does print using scientific notation.)

File size: 13.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Mar  2 07:32:57 2004
4;;;; Contains: Tests of printing of floating point numbers
5
6(in-package :cl-test)
7
8(compile-and-load "printer-aux.lsp")
9
10(deftest print.short-float.1
11  (with-standard-io-syntax
12   (let ((*print-readably* nil)
13         (*read-default-float-format* 'short-float))
14     (loop for i from -4000 to 4000
15           for f = (float i 0.0s0)
16           for s1 = (with-output-to-string (s) (prin1 f s))
17           for s2 = (format nil "~A.0" i)
18           unless (equalp s1 s2)
19           collect (list i f s1 s2))))
20  nil)
21
22(deftest print.short-float.2
23  (with-standard-io-syntax
24   (let ((*print-readably* nil)
25         (*read-default-float-format* 'short-float))
26     (loop for i = (- (random 20000000) 10000000)
27           for f = (float i 0.0s0)
28           for s1 = (with-output-to-string (s) (prin1 f s))
29           for s2 = (format nil "~A.0" i)
30           repeat 10000
31           unless (or (= i -10000000) ; the only value that's out of range
32                      (/= i (rational f)) ; not enough bits
33                   ;; (> (nth-value 1 (integer-decode-float f)) 0)
34                   (equalp s1 s2))
35           collect (list i f s1 s2))))
36  nil)
37
38(defparameter *possible-short-float-exponent-markers*
39  (loop for type in '(short-float single-float double-float long-float)
40                     for c across "SFDL"
41                     when (subtypep 'short-float type)
42                     nconc (list c (char-downcase c))))
43
44(deftest print.short-float.3
45  (let ((chars *possible-short-float-exponent-markers*))
46    (loop for type in '(single-float double-float long-float)
47          nconc
48          (and (not (subtypep 'short-float type))
49               (with-standard-io-syntax
50                (let ((*print-readably* nil)
51                      (*read-default-float-format* type))
52                  (loop for i from -4000 to 4000
53                        for f = (float i 0.0s0)
54                        for s1 = (with-output-to-string (s) (prin1 f s))
55                        for len1 = (length s1)
56                        for s2 = (format nil "~A.0" i)
57                        unless (and (> len1 4)
58                                    (string-equal s1 s2 :start1 0 :end1 (- len1 2))
59                                    (eql (char s1 (- len1 1)) #\0)
60                                    (member (char s1 (- len1 2)) chars))
61                        collect (list type i f s1 s2)))))))
62  nil)
63
64(deftest print.short-float.4
65  (let ((chars *possible-short-float-exponent-markers*))
66    (loop for type in '(single-float double-float long-float)
67          nconc
68          (and (not (subtypep 'short-float type))
69               (with-standard-io-syntax
70                (let ((*print-readably* nil)
71                      (*read-default-float-format* type))
72                  (loop for i = (- (random 20000000) 10000000)
73                        for f = (float i 0.0s0)
74                        for s1 = (with-output-to-string (s) (prin1 f s))
75                        for len1 = (length s1)
76                        for s2 = (format nil "~A.0" i)
77                        repeat 10000
78                        unless (or (= i -10000000)
79                                   (/= i (rational f))  ;; not enough bits
80                                ;; (> (nth-value 1 (integer-decode-float f)) 0)
81                                (and (> len1 4)
82                                     (string-equal s1 s2 :start1 0 :end1 (- len1 2))
83                                     (eql (char s1 (- len1 1)) #\0)
84                                     (member (char s1 (- len1 2)) chars)))
85                        collect (list type i f s1 s2)))))))
86  nil)
87
88(deftest print.short-float.random
89  (let ((lower-bound (if (< (log least-positive-short-float 10) -100)
90                         (expt 0.1s0 100)
91                       least-positive-short-float))
92        (upper-bound (/ (if (> (log most-positive-short-float 10) 100)
93                            (expt 10.0s0 100)
94                          most-positive-short-float)
95                        10)))
96    (loop for sf = lower-bound then (* 10 sf)
97          while (< sf upper-bound)
98          nconc
99          (loop for x = (handler-case (random sf) (arithmetic-error (c) 0.0s0))
100                for y = (if (coin) (- x) x)
101                repeat 10
102                nconc (randomly-check-readability y))))
103  nil)
104
105;;; single floats
106
107(deftest print.single-float.1
108  (with-standard-io-syntax
109   (let ((*print-readably* nil)
110         (*read-default-float-format* 'single-float))
111     (loop for i from -4000 to 4000
112           for f = (float i 0.0f0)
113           for s1 = (with-output-to-string (s) (prin1 f s))
114           for s2 = (format nil "~A.0" i)
115           unless (equalp s1 s2)
116           collect (list i f s1 s2))))
117  nil)
118
119(deftest print.single-float.2
120  (with-standard-io-syntax
121   (let ((*print-readably* nil)
122         (*read-default-float-format* 'single-float))
123     (loop for i = (- (random 20000000) 10000000)
124           for f = (float i 0.0f0)
125           for s1 = (with-output-to-string (s) (prin1 f s))
126           for s2 = (format nil "~A.0" i)
127           repeat 10000
128           unless (or (= i -10000000) ; out of range
129                      (/= i (rational f))  ;; not enough bits
130                      ;; (> (nth-value 1 (integer-decode-float f)) 0)
131                      (equalp s1 s2))
132           collect (list i f s1 s2))))
133  nil)
134
135(defparameter *possible-single-float-exponent-markers*
136  (loop for type in '(short-float single-float double-float long-float)
137                     for c across "SFDL"
138                     when (subtypep 'single-float type)
139                     nconc (list c (char-downcase c))))
140
141(deftest print.single-float.3
142  (let ((chars *possible-single-float-exponent-markers*))
143    (loop for type in '(short-float double-float long-float)
144          nconc
145          (and (not (subtypep 'single-float type))
146               (with-standard-io-syntax
147                (let ((*print-readably* nil)
148                      (*read-default-float-format* type))
149                  (loop for i from -4000 to 4000
150                        for f = (float i 0.0f0)
151                        for s1 = (with-output-to-string (s) (prin1 f s))
152                        for len1 = (length s1)
153                        for s2 = (format nil "~A.0" i)
154                        unless (and (> len1 4)
155                                    (string-equal s1 s2 :start1 0 :end1 (- len1 2))
156                                    (eql (char s1 (- len1 1)) #\0)
157                                    (member (char s1 (- len1 2)) chars))
158                        collect (list type i f s1 s2)))))))
159  nil)
160
161(deftest print.single-float.4
162  (let ((chars *possible-single-float-exponent-markers*))
163    (loop for type in '(short-float double-float long-float)
164          nconc
165          (and (not (subtypep 'single-float type))
166               (with-standard-io-syntax
167                (let ((*print-readably* nil)
168                      (*read-default-float-format* type))
169                  (loop for i = (- (random 20000000) 10000000)
170                        for f = (float i 0.0f0)
171                        for s1 = (with-output-to-string (s) (prin1 f s))
172                        for len1 = (length s1)
173                        for s2 = (format nil "~A.0" i)
174                        repeat 10000
175                        unless (or (= i -10000000)
176                                   (/= i (rational f))  ;; not enough bits
177                                ;; (> (nth-value 1 (integer-decode-float f)) 0)
178                                (and (> len1 4)
179                                     (string-equal s1 s2 :start1 0 :end1 (- len1 2))
180                                     (eql (char s1 (- len1 1)) #\0)
181                                     (member (char s1 (- len1 2)) chars)))
182                        collect (list type i f s1 s2)))))))
183  nil)
184
185(deftest print.single-float.random
186  (let ((lower-bound (if (< (log least-positive-single-float 10) -100)
187                         (expt 0.1f0 100)
188                       least-positive-single-float))
189        (upper-bound (/ (if (> (log most-positive-single-float 10) 100)
190                            (expt 10.0f0 100)
191                          most-positive-single-float)
192                        10)))
193    (loop for f = lower-bound then (* 10 f)
194          while (< f upper-bound)
195          nconc
196          (loop for x = (handler-case (random f) (arithmetic-error (c) 0.0f0))
197                for y = (if (coin) (- x) x)
198                repeat 10
199                nconc (randomly-check-readability y))))
200  nil)
201
202;;; double float
203
204(deftest print.double-float.1
205  (with-standard-io-syntax
206   (let ((*print-readably* nil)
207         (*read-default-float-format* 'double-float))
208     (loop for i from -4000 to 4000
209           for f = (float i 0.0d0)
210           for s1 = (with-output-to-string (s) (prin1 f s))
211           for s2 = (format nil "~A.0" i)
212           unless (equalp s1 s2)
213           collect (list i f s1 s2))))
214  nil)
215
216(deftest print.double-float.2
217  (with-standard-io-syntax
218   (let ((*print-readably* nil)
219         (*read-default-float-format* 'double-float))
220     (loop for i = (- (random 20000000) 10000000)
221           for f = (float i 0.0d0)
222           for s1 = (with-output-to-string (s) (prin1 f s))
223           for s2 = (format nil "~A.0" i)
224           repeat 10000
225           unless (or (= i -10000000)
226                      (/= i (rational f))  ;; not enough bits
227                      ;; (> (nth-value 1 (integer-decode-float f)) 0)
228                      (equalp s1 s2))
229           collect (list i f s1 s2))))
230  nil)
231
232(defparameter *possible-double-float-exponent-markers*
233  (loop for type in '(short-float single-float double-float long-float)
234                     for c across "SFDL"
235                     when (subtypep 'double-float type)
236                     nconc (list c (char-downcase c))))
237
238(deftest print.double-float.3
239  (let ((chars *possible-double-float-exponent-markers*))
240    (loop for type in '(short-float double-float long-float)
241          nconc
242          (and (not (subtypep 'double-float type))
243               (with-standard-io-syntax
244                (let ((*print-readably* nil)
245                      (*read-default-float-format* type))
246                  (loop for i from -4000 to 4000
247                        for f = (float i 0.0d0)
248                        for s1 = (with-output-to-string (s) (prin1 f s))
249                        for len1 = (length s1)
250                        for s2 = (format nil "~A.0" i)
251                        unless (and (> len1 4)
252                                    (string-equal s1 s2 :start1 0 :end1 (- len1 2))
253                                    (eql (char s1 (- len1 1)) #\0)
254                                    (member (char s1 (- len1 2)) chars))
255                        collect (list type i f s1 s2)))))))
256  nil)
257
258(deftest print.double-float.4
259  (let ((chars *possible-double-float-exponent-markers*))
260    (loop for type in '(short-float double-float long-float)
261          nconc
262          (and (not (subtypep 'double-float type))
263               (with-standard-io-syntax
264                (let ((*print-readably* nil)
265                      (*read-default-float-format* type))
266                  (loop for i = (- (random 20000000) 10000000)
267                        for f = (float i 0.0d0)
268                        for s1 = (with-output-to-string (s) (prin1 f s))
269                        for len1 = (length s1)
270                        for s2 = (format nil "~A.0" i)
271                        repeat 10000
272                        unless (or (= i -10000000)
273                                   (/= i (rational f))  ;; not enough bits
274                                ;; (> (nth-value 1 (integer-decode-float f)) 0)
275                                (and (> len1 4)
276                                     (string-equal s1 s2 :start1 0 :end1 (- len1 2))
277                                     (eql (char s1 (- len1 1)) #\0)
278                                     (member (char s1 (- len1 2)) chars)))
279                        collect (list type i f s1 s2)))))))
280  nil)
281
282(deftest print.double-float.random
283  (let ((lower-bound (if (< (log least-positive-double-float 10) -100)
284                         (expt 0.1d0 100)
285                       least-positive-double-float))
286        (upper-bound (/ (if (> (log most-positive-double-float 10) 100)
287                            (expt 10.0d0 100)
288                          most-positive-double-float)
289                        10)))
290    (loop for f = lower-bound then (* 10 f)
291          while (< f upper-bound)
292          nconc
293          (loop for x = (handler-case (random f) (arithmetic-error (c) 0.0d0))
294                for y = (if (coin) (- x) x)
295                repeat 10
296                nconc (randomly-check-readability y))))
297  nil)
298
299;;; long float
300
301(deftest print.long-float.1
302  (with-standard-io-syntax
303   (let ((*print-readably* nil)
304         (*read-default-float-format* 'long-float))
305     (loop for i from -4000 to 4000
306           for f = (float i 0.0l0)
307           for s1 = (with-output-to-string (s) (prin1 f s))
308           for s2 = (format nil "~A.0" i)
309           unless (equalp s1 s2)
310           collect (list i f s1 s2))))
311  nil)
312
313(deftest print.long-float.2
314  (with-standard-io-syntax
315   (let ((*print-readably* nil)
316         (*read-default-float-format* 'long-float))
317     (loop for i = (- (random 20000000) 10000000)
318           for f = (float i 0.0l0)
319           for s1 = (with-output-to-string (s) (prin1 f s))
320           for s2 = (format nil "~A.0" i)
321           repeat 10000
322           unless (or (= i -10000000)
323                      (/= i (rational f)) ;; not enough bits
324                      ;; (> (nth-value 1 (integer-decode-float f)) 0)
325                      (equalp s1 s2))
326           collect (list i f s1 s2))))
327  nil)
328
329(defparameter *possible-long-float-exponent-markers*
330  (loop for type in '(short-float single-float double-float long-float)
331                     for c across "SFDL"
332                     when (subtypep 'long-float type)
333                     nconc (list c (char-downcase c))))
334
335(deftest print.long-float.3
336  (let ((chars *possible-long-float-exponent-markers*))
337    (loop for type in '(short-float double-float long-float)
338          nconc
339          (and (not (subtypep 'long-float type))
340               (with-standard-io-syntax
341                (let ((*print-readably* nil)
342                      (*read-default-float-format* type))
343                  (loop for i from -4000 to 4000
344                        for f = (float i 0.0l0)
345                        for s1 = (with-output-to-string (s) (prin1 f s))
346                        for len1 = (length s1)
347                        for s2 = (format nil "~A.0" i)
348                        unless (and (> len1 4)
349                                    (string-equal s1 s2 :start1 0 :end1 (- len1 2))
350                                    (eql (char s1 (- len1 1)) #\0)
351                                    (member (char s1 (- len1 2)) chars))
352                        collect (list type i f s1 s2)))))))
353  nil)
354
355(deftest print.long-float.4
356  (let ((chars *possible-long-float-exponent-markers*))
357    (loop for type in '(short-float double-float long-float)
358          nconc
359          (and (not (subtypep 'long-float type))
360               (with-standard-io-syntax
361                (let ((*print-readably* nil)
362                      (*read-default-float-format* type))
363                  (loop for i = (- (random 20000000) 10000000)
364                        for f = (float i 0.0l0)
365                        for s1 = (with-output-to-string (s) (prin1 f s))
366                        for len1 = (length s1)
367                        for s2 = (format nil "~A.0" i)
368                        repeat 10000
369                        unless (or (= i -10000000)
370                                   (/= i (rational f))  ;; not enough bits
371                                ;; (> (nth-value 1 (integer-decode-float f)) 0)
372                                (and (> len1 4)
373                                     (string-equal s1 s2 :start1 0 :end1 (- len1 2))
374                                     (eql (char s1 (- len1 1)) #\0)
375                                     (member (char s1 (- len1 2)) chars)))
376                        collect (list type i f s1 s2)))))))
377  nil)
378
379(deftest print.long-float.random
380  (let ((lower-bound (if (< (log least-positive-long-float 10) -100)
381                         (expt 0.1l0 100)
382                       least-positive-long-float))
383        (upper-bound (/ (if (> (log most-positive-long-float 10) 100)
384                            (expt 10.0l0 100)
385                          most-positive-long-float)
386                        10)))
387    (loop for f = lower-bound then (* 10 f)
388          while (< f upper-bound)
389          nconc
390          (loop for x = (handler-case (random f) (arithmetic-error (c) 0.0l0))
391                for y = (if (coin) (- x) x)
392                repeat 10
393                nconc (randomly-check-readability y))))
394  nil)
Note: See TracBrowser for help on using the repository browser.