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

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

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