2
;;;; Author: Paul Dietz
3
;;;; Created: Tue Mar 2 07:32:57 2004
4
;;;; Contains: Tests of printing of floating point numbers
8
(compile-and-load "printer-aux.lsp")
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)
19
collect (list i f s1 s2))))
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)
31
unless (or (/= i (rational f)) ; not enough bits
32
;; (> (nth-value 1 (integer-decode-float f)) 0)
34
collect (list i f s1 s2))))
37
(defparameter *possible-short-float-exponent-markers*
38
(loop for type in '(short-float single-float double-float long-float)
40
when (subtypep 'short-float type)
41
nconc (list c (char-downcase c))))
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)
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)))))))
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)
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)
77
unless (or (/= i (rational f)) ;; not enough bits
78
;; (> (nth-value 1 (integer-decode-float f)) 0)
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)))))))
86
(deftest print.short-float.random
87
(let ((lower-bound (if (< (log least-positive-short-float 10) -100)
89
least-positive-short-float))
90
(upper-bound (/ (if (> (log most-positive-short-float 10) 100)
92
most-positive-short-float)
94
(loop for sf = lower-bound then (* 10 sf)
95
while (< sf upper-bound)
97
(loop for x = (handler-case (random sf) (arithmetic-error (c) 0.0s0))
98
for y = (if (coin) (- x) x)
100
nconc (randomly-check-readability y))))
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))))
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)
126
unless (or (/= i (rational f)) ;; not enough bits
127
;; (> (nth-value 1 (integer-decode-float f)) 0)
129
collect (list i f s1 s2))))
132
(defparameter *possible-single-float-exponent-markers*
133
(loop for type in '(short-float single-float double-float long-float)
135
when (subtypep 'single-float type)
136
nconc (list c (char-downcase c))))
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)
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)))))))
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)
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)
172
unless (or (/= i (rational f)) ;; not enough bits
173
;; (> (nth-value 1 (integer-decode-float f)) 0)
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)))))))
181
(deftest print.single-float.random
182
(let ((lower-bound (if (< (log least-positive-single-float 10) -100)
184
least-positive-single-float))
185
(upper-bound (/ (if (> (log most-positive-single-float 10) 100)
187
most-positive-single-float)
189
(loop for f = lower-bound then (* 10 f)
190
while (< f upper-bound)
192
(loop for x = (handler-case (random f) (arithmetic-error (c) 0.0f0))
193
for y = (if (coin) (- x) x)
195
nconc (randomly-check-readability y))))
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))))
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)
221
unless (or (/= i (rational f)) ;; not enough bits
222
;; (> (nth-value 1 (integer-decode-float f)) 0)
224
collect (list i f s1 s2))))
227
(defparameter *possible-double-float-exponent-markers*
228
(loop for type in '(short-float single-float double-float long-float)
230
when (subtypep 'double-float type)
231
nconc (list c (char-downcase c))))
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)
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)))))))
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)
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)
267
unless (or (/= i (rational f)) ;; not enough bits
268
;; (> (nth-value 1 (integer-decode-float f)) 0)
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)))))))
276
(deftest print.double-float.random
277
(let ((lower-bound (if (< (log least-positive-double-float 10) -100)
279
least-positive-double-float))
280
(upper-bound (/ (if (> (log most-positive-double-float 10) 100)
282
most-positive-double-float)
284
(loop for f = lower-bound then (* 10 f)
285
while (< f upper-bound)
287
(loop for x = (handler-case (random f) (arithmetic-error (c) 0.0d0))
288
for y = (if (coin) (- x) x)
290
nconc (randomly-check-readability y))))
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))))
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)
316
unless (or (/= i (rational f)) ;; not enough bits
317
;; (> (nth-value 1 (integer-decode-float f)) 0)
319
collect (list i f s1 s2))))
322
(defparameter *possible-long-float-exponent-markers*
323
(loop for type in '(short-float single-float double-float long-float)
325
when (subtypep 'long-float type)
326
nconc (list c (char-downcase c))))
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)
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)))))))
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)
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)
362
unless (or (/= i (rational f)) ;; not enough bits
363
;; (> (nth-value 1 (integer-decode-float f)) 0)
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)))))))
371
(deftest print.long-float.random
372
(let ((lower-bound (if (< (log least-positive-long-float 10) -100)
374
least-positive-long-float))
375
(upper-bound (/ (if (> (log most-positive-long-float 10) 100)
377
most-positive-long-float)
379
(loop for f = lower-bound then (* 10 f)
380
while (< f upper-bound)
382
(loop for x = (handler-case (random f) (arithmetic-error (c) 0.0l0))
383
for y = (if (coin) (- x) x)
385
nconc (randomly-check-readability y))))
b'\\ No newline at end of file'
added
removed
ansi-tests/print-floats.lsp
