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

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

PRINT.*-FLOAT.2: if the call to RANDOM returns 0, I is initialized
to -10000000 and F should be printed as -1.0e7 (it is, correctly,
but the tests don't expect that.)
See CLHS 22.1.3.1.3.

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