print-floats.lsp 16.2 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Mar  2 07:32:57 2004
;;;; Contains: Tests of printing of floating point numbers

(in-package :cl-test)

8

9

10 11
(deftest print.short-float.1
  (with-standard-io-syntax
12
   (let ((*print-readably* nil)
sds's avatar
sds committed
13
         (*read-default-float-format* 'short-float))
14
     (loop for i from -4000 to 4000
sds's avatar
sds committed
15 16 17 18 19
           for f = (float i 0.0s0)
           for s1 = (with-output-to-string (s) (prin1 f s))
           for s2 = (format nil "~A.0" i)
           unless (equalp s1 s2)
           collect (list i f s1 s2))))
20 21 22 23
  nil)

(deftest print.short-float.2
  (with-standard-io-syntax
24
   (let ((*print-readably* nil)
sds's avatar
sds committed
25
         (*read-default-float-format* 'short-float))
26
     (loop for i = (- (random 20000000) 10000000)
sds's avatar
sds committed
27 28 29 30 31 32 33 34
           for f = (float i 0.0s0)
           for s1 = (with-output-to-string (s) (prin1 f s))
           for s2 = (format nil "~A.0" i)
           repeat 10000
           unless (or (/= i (rational f)) ; not enough bits
                   ;; (> (nth-value 1 (integer-decode-float f)) 0)
                   (equalp s1 s2))
           collect (list i f s1 s2))))
35 36 37 38
  nil)

(defparameter *possible-short-float-exponent-markers*
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
39 40 41
                     for c across "SFDL"
                     when (subtypep 'short-float type)
                     nconc (list c (char-downcase c))))
42 43 44 45

(deftest print.short-float.3
  (let ((chars *possible-short-float-exponent-markers*))
    (loop for type in '(single-float double-float long-float)
sds's avatar
sds committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
          nconc
          (and (not (subtypep 'short-float type))
               (with-standard-io-syntax
                (let ((*print-readably* nil)
                      (*read-default-float-format* type))
                  (loop for i from -4000 to 4000
                        for f = (float i 0.0s0)
                        for s1 = (with-output-to-string (s) (prin1 f s))
                        for len1 = (length s1)
                        for s2 = (format nil "~A.0" i)
                        unless (and (> len1 4)
                                    (string-equal s1 s2 :start1 0 :end1 (- len1 2))
                                    (eql (char s1 (- len1 1)) #\0)
                                    (member (char s1 (- len1 2)) chars))
                        collect (list type i f s1 s2)))))))
61 62 63 64 65
  nil)

(deftest print.short-float.4
  (let ((chars *possible-short-float-exponent-markers*))
    (loop for type in '(single-float double-float long-float)
sds's avatar
sds committed
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
          nconc
          (and (not (subtypep 'short-float type))
               (with-standard-io-syntax
                (let ((*print-readably* nil)
                      (*read-default-float-format* type))
                  (loop for i = (- (random 20000000) 10000000)
                        for f = (float i 0.0s0)
                        for s1 = (with-output-to-string (s) (prin1 f s))
                        for len1 = (length s1)
                        for s2 = (format nil "~A.0" i)
                        repeat 10000
                        unless (or (/= i (rational f))  ;; not enough bits
                                ;; (> (nth-value 1 (integer-decode-float f)) 0)
                                (and (> len1 4)
                                     (string-equal s1 s2 :start1 0 :end1 (- len1 2))
                                     (eql (char s1 (- len1 1)) #\0)
                                     (member (char s1 (- len1 2)) chars)))
                        collect (list type i f s1 s2)))))))
84 85 86 87
  nil)

(deftest print.short-float.random
  (let ((lower-bound (if (< (log least-positive-short-float 10) -100)
sds's avatar
sds committed
88 89 90 91 92 93
                         (expt 0.1s0 100)
                       least-positive-short-float))
        (upper-bound (/ (if (> (log most-positive-short-float 10) 100)
                            (expt 10.0s0 100)
                          most-positive-short-float)
                        10)))
94
    (loop for sf = lower-bound then (* 10 sf)
sds's avatar
sds committed
95 96 97 98 99 100
          while (< sf upper-bound)
          nconc
          (loop for x = (handler-case (random sf) (arithmetic-error (c) 0.0s0))
                for y = (if (coin) (- x) x)
                repeat 10
                nconc (randomly-check-readability y))))
101 102 103 104 105 106
  nil)

;;; single floats

(deftest print.single-float.1
  (with-standard-io-syntax
107
   (let ((*print-readably* nil)
sds's avatar
sds committed
108
         (*read-default-float-format* 'single-float))
109
     (loop for i from -4000 to 4000
sds's avatar
sds committed
110 111 112 113 114
           for f = (float i 0.0f0)
           for s1 = (with-output-to-string (s) (prin1 f s))
           for s2 = (format nil "~A.0" i)
           unless (equalp s1 s2)
           collect (list i f s1 s2))))
115 116 117 118
  nil)

(deftest print.single-float.2
  (with-standard-io-syntax
119
   (let ((*print-readably* nil)
sds's avatar
sds committed
120
         (*read-default-float-format* 'single-float))
121
     (loop for i = (- (random 20000000) 10000000)
sds's avatar
sds committed
122 123 124 125 126 127 128 129
           for f = (float i 0.0f0)
           for s1 = (with-output-to-string (s) (prin1 f s))
           for s2 = (format nil "~A.0" i)
           repeat 10000
           unless (or (/= i (rational f))  ;; not enough bits
                   ;; (> (nth-value 1 (integer-decode-float f)) 0)
                   (equalp s1 s2))
           collect (list i f s1 s2))))
130 131 132 133
  nil)

(defparameter *possible-single-float-exponent-markers*
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
134 135 136
                     for c across "SFDL"
                     when (subtypep 'single-float type)
                     nconc (list c (char-downcase c))))
137 138 139 140

(deftest print.single-float.3
  (let ((chars *possible-single-float-exponent-markers*))
    (loop for type in '(short-float double-float long-float)
sds's avatar
sds committed
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
          nconc
          (and (not (subtypep 'single-float type))
               (with-standard-io-syntax
                (let ((*print-readably* nil)
                      (*read-default-float-format* type))
                  (loop for i from -4000 to 4000
                        for f = (float i 0.0f0)
                        for s1 = (with-output-to-string (s) (prin1 f s))
                        for len1 = (length s1)
                        for s2 = (format nil "~A.0" i)
                        unless (and (> len1 4)
                                    (string-equal s1 s2 :start1 0 :end1 (- len1 2))
                                    (eql (char s1 (- len1 1)) #\0)
                                    (member (char s1 (- len1 2)) chars))
                        collect (list type i f s1 s2)))))))
156 157 158 159 160
  nil)

(deftest print.single-float.4
  (let ((chars *possible-single-float-exponent-markers*))
    (loop for type in '(short-float double-float long-float)
sds's avatar
sds committed
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
          nconc
          (and (not (subtypep 'single-float type))
               (with-standard-io-syntax
                (let ((*print-readably* nil)
                      (*read-default-float-format* type))
                  (loop for i = (- (random 20000000) 10000000)
                        for f = (float i 0.0f0)
                        for s1 = (with-output-to-string (s) (prin1 f s))
                        for len1 = (length s1)
                        for s2 = (format nil "~A.0" i)
                        repeat 10000
                        unless (or (/= i (rational f))  ;; not enough bits
                                ;; (> (nth-value 1 (integer-decode-float f)) 0)
                                (and (> len1 4)
                                     (string-equal s1 s2 :start1 0 :end1 (- len1 2))
                                     (eql (char s1 (- len1 1)) #\0)
                                     (member (char s1 (- len1 2)) chars)))
                        collect (list type i f s1 s2)))))))
179 180 181 182
  nil)

(deftest print.single-float.random
  (let ((lower-bound (if (< (log least-positive-single-float 10) -100)
sds's avatar
sds committed
183 184 185 186 187 188
                         (expt 0.1f0 100)
                       least-positive-single-float))
        (upper-bound (/ (if (> (log most-positive-single-float 10) 100)
                            (expt 10.0f0 100)
                          most-positive-single-float)
                        10)))
189
    (loop for f = lower-bound then (* 10 f)
sds's avatar
sds committed
190 191 192 193 194 195
          while (< f upper-bound)
          nconc
          (loop for x = (handler-case (random f) (arithmetic-error (c) 0.0f0))
                for y = (if (coin) (- x) x)
                repeat 10
                nconc (randomly-check-readability y))))
196 197 198 199 200 201
  nil)

;;; double float

(deftest print.double-float.1
  (with-standard-io-syntax
202
   (let ((*print-readably* nil)
sds's avatar
sds committed
203
         (*read-default-float-format* 'double-float))
204
     (loop for i from -4000 to 4000
sds's avatar
sds committed
205 206 207 208 209
           for f = (float i 0.0d0)
           for s1 = (with-output-to-string (s) (prin1 f s))
           for s2 = (format nil "~A.0" i)
           unless (equalp s1 s2)
           collect (list i f s1 s2))))
210 211 212 213
  nil)

(deftest print.double-float.2
  (with-standard-io-syntax
214
   (let ((*print-readably* nil)
sds's avatar
sds committed
215
         (*read-default-float-format* 'double-float))
216
     (loop for i = (- (random 20000000) 10000000)
sds's avatar
sds committed
217 218 219 220 221 222 223 224
           for f = (float i 0.0d0)
           for s1 = (with-output-to-string (s) (prin1 f s))
           for s2 = (format nil "~A.0" i)
           repeat 10000
           unless (or (/= i (rational f))  ;; not enough bits
                   ;; (> (nth-value 1 (integer-decode-float f)) 0)
                   (equalp s1 s2))
           collect (list i f s1 s2))))
225 226 227 228
  nil)

(defparameter *possible-double-float-exponent-markers*
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
229 230 231
                     for c across "SFDL"
                     when (subtypep 'double-float type)
                     nconc (list c (char-downcase c))))
232 233 234 235

(deftest print.double-float.3
  (let ((chars *possible-double-float-exponent-markers*))
    (loop for type in '(short-float double-float long-float)
sds's avatar
sds committed
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
          nconc
          (and (not (subtypep 'double-float type))
               (with-standard-io-syntax
                (let ((*print-readably* nil)
                      (*read-default-float-format* type))
                  (loop for i from -4000 to 4000
                        for f = (float i 0.0d0)
                        for s1 = (with-output-to-string (s) (prin1 f s))
                        for len1 = (length s1)
                        for s2 = (format nil "~A.0" i)
                        unless (and (> len1 4)
                                    (string-equal s1 s2 :start1 0 :end1 (- len1 2))
                                    (eql (char s1 (- len1 1)) #\0)
                                    (member (char s1 (- len1 2)) chars))
                        collect (list type i f s1 s2)))))))
251 252 253 254 255
  nil)

(deftest print.double-float.4
  (let ((chars *possible-double-float-exponent-markers*))
    (loop for type in '(short-float double-float long-float)
sds's avatar
sds committed
256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
          nconc
          (and (not (subtypep 'double-float type))
               (with-standard-io-syntax
                (let ((*print-readably* nil)
                      (*read-default-float-format* type))
                  (loop for i = (- (random 20000000) 10000000)
                        for f = (float i 0.0d0)
                        for s1 = (with-output-to-string (s) (prin1 f s))
                        for len1 = (length s1)
                        for s2 = (format nil "~A.0" i)
                        repeat 10000
                        unless (or (/= i (rational f))  ;; not enough bits
                                ;; (> (nth-value 1 (integer-decode-float f)) 0)
                                (and (> len1 4)
                                     (string-equal s1 s2 :start1 0 :end1 (- len1 2))
                                     (eql (char s1 (- len1 1)) #\0)
                                     (member (char s1 (- len1 2)) chars)))
                        collect (list type i f s1 s2)))))))
274 275 276 277
  nil)

(deftest print.double-float.random
  (let ((lower-bound (if (< (log least-positive-double-float 10) -100)
sds's avatar
sds committed
278 279 280 281 282 283
                         (expt 0.1d0 100)
                       least-positive-double-float))
        (upper-bound (/ (if (> (log most-positive-double-float 10) 100)
                            (expt 10.0d0 100)
                          most-positive-double-float)
                        10)))
284
    (loop for f = lower-bound then (* 10 f)
sds's avatar
sds committed
285 286 287 288 289 290
          while (< f upper-bound)
          nconc
          (loop for x = (handler-case (random f) (arithmetic-error (c) 0.0d0))
                for y = (if (coin) (- x) x)
                repeat 10
                nconc (randomly-check-readability y))))
291 292 293 294 295 296
  nil)

;;; long float

(deftest print.long-float.1
  (with-standard-io-syntax
297
   (let ((*print-readably* nil)
sds's avatar
sds committed
298
         (*read-default-float-format* 'long-float))
299
     (loop for i from -4000 to 4000
sds's avatar
sds committed
300 301 302 303 304
           for f = (float i 0.0l0)
           for s1 = (with-output-to-string (s) (prin1 f s))
           for s2 = (format nil "~A.0" i)
           unless (equalp s1 s2)
           collect (list i f s1 s2))))
305 306 307 308
  nil)

(deftest print.long-float.2
  (with-standard-io-syntax
309
   (let ((*print-readably* nil)
sds's avatar
sds committed
310
         (*read-default-float-format* 'long-float))
311
     (loop for i = (- (random 20000000) 10000000)
sds's avatar
sds committed
312 313 314 315 316 317 318 319
           for f = (float i 0.0l0)
           for s1 = (with-output-to-string (s) (prin1 f s))
           for s2 = (format nil "~A.0" i)
           repeat 10000
           unless (or (/= i (rational f)) ;; not enough bits
                   ;; (> (nth-value 1 (integer-decode-float f)) 0)
                   (equalp s1 s2))
           collect (list i f s1 s2))))
320 321 322 323
  nil)

(defparameter *possible-long-float-exponent-markers*
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
324 325 326
                     for c across "SFDL"
                     when (subtypep 'long-float type)
                     nconc (list c (char-downcase c))))
327 328 329 330

(deftest print.long-float.3
  (let ((chars *possible-long-float-exponent-markers*))
    (loop for type in '(short-float double-float long-float)
sds's avatar
sds committed
331 332 333 334 335 336 337 338 339 340 341 342 343 344 345
          nconc
          (and (not (subtypep 'long-float type))
               (with-standard-io-syntax
                (let ((*print-readably* nil)
                      (*read-default-float-format* type))
                  (loop for i from -4000 to 4000
                        for f = (float i 0.0l0)
                        for s1 = (with-output-to-string (s) (prin1 f s))
                        for len1 = (length s1)
                        for s2 = (format nil "~A.0" i)
                        unless (and (> len1 4)
                                    (string-equal s1 s2 :start1 0 :end1 (- len1 2))
                                    (eql (char s1 (- len1 1)) #\0)
                                    (member (char s1 (- len1 2)) chars))
                        collect (list type i f s1 s2)))))))
346 347 348 349 350
  nil)

(deftest print.long-float.4
  (let ((chars *possible-long-float-exponent-markers*))
    (loop for type in '(short-float double-float long-float)
sds's avatar
sds committed
351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368
          nconc
          (and (not (subtypep 'long-float type))
               (with-standard-io-syntax
                (let ((*print-readably* nil)
                      (*read-default-float-format* type))
                  (loop for i = (- (random 20000000) 10000000)
                        for f = (float i 0.0l0)
                        for s1 = (with-output-to-string (s) (prin1 f s))
                        for len1 = (length s1)
                        for s2 = (format nil "~A.0" i)
                        repeat 10000
                        unless (or (/= i (rational f))  ;; not enough bits
                                ;; (> (nth-value 1 (integer-decode-float f)) 0)
                                (and (> len1 4)
                                     (string-equal s1 s2 :start1 0 :end1 (- len1 2))
                                     (eql (char s1 (- len1 1)) #\0)
                                     (member (char s1 (- len1 2)) chars)))
                        collect (list type i f s1 s2)))))))
369 370 371 372
  nil)

(deftest print.long-float.random
  (let ((lower-bound (if (< (log least-positive-long-float 10) -100)
sds's avatar
sds committed
373 374 375 376 377 378
                         (expt 0.1l0 100)
                       least-positive-long-float))
        (upper-bound (/ (if (> (log most-positive-long-float 10) 100)
                            (expt 10.0l0 100)
                          most-positive-long-float)
                        10)))
379
    (loop for f = lower-bound then (* 10 f)
sds's avatar
sds committed
380 381 382 383 384 385 386
          while (< f upper-bound)
          nconc
          (loop for x = (handler-case (random f) (arithmetic-error (c) 0.0l0))
                for y = (if (coin) (- x) x)
                repeat 10
                nconc (randomly-check-readability y))))
  nil)