Commit 41e455d5 authored by pfdietz's avatar pfdietz

Added tests for printing floating point numbers.

parent 1830535c
......@@ -11,4 +11,5 @@
(load "print-integers.lsp")
(load "print-ratios.lsp")
(load "print-floats.lsp")
;-*- 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)
(deftest print.short-float.1
(with-standard-io-syntax
(let ((*read-default-float-format* 'short-float))
(loop for i from -4000 to 4000
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))))
nil)
(deftest print.short-float.2
(with-standard-io-syntax
(let ((*read-default-float-format* 'short-float))
(loop for i = (- (random 20000001) 10000000)
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 f) (equalp s1 s2)) ;; not enough bits
collect (list i f s1 s2))))
nil)
(defparameter *possible-short-float-exponent-markers*
(loop for type in '(short-float single-float double-float long-float)
for c across "SFDL"
when (subtypep 'short-float type)
nconc (list c (char-downcase c))))
(deftest print.short-float.3
(let ((chars *possible-short-float-exponent-markers*))
(loop for type in '(single-float double-float long-float)
nconc
(and (not (subtypep 'short-float type))
(with-standard-io-syntax
(let ((*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)))))))
nil)
(deftest print.short-float.4
(let ((chars *possible-short-float-exponent-markers*))
(loop for type in '(single-float double-float long-float)
nconc
(and (not (subtypep 'short-float type))
(with-standard-io-syntax
(let ((*read-default-float-format* type))
(loop for i = (- (random 20000001) 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 f) ;; not enough bits
(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)))))))
nil)
(deftest print.short-float.random
(let ((lower-bound (if (< (log least-positive-short-float 10) -100)
(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)))
(loop for sf = lower-bound then (* 10 sf)
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))))
nil)
;;; single floats
(deftest print.single-float.1
(with-standard-io-syntax
(let ((*read-default-float-format* 'single-float))
(loop for i from -4000 to 4000
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))))
nil)
(deftest print.single-float.2
(with-standard-io-syntax
(let ((*read-default-float-format* 'single-float))
(loop for i = (- (random 20000001) 10000000)
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 f) (equalp s1 s2)) ;; not enough bits
collect (list i f s1 s2))))
nil)
(defparameter *possible-single-float-exponent-markers*
(loop for type in '(short-float single-float double-float long-float)
for c across "SFDL"
when (subtypep 'single-float type)
nconc (list c (char-downcase c))))
(deftest print.single-float.3
(let ((chars *possible-single-float-exponent-markers*))
(loop for type in '(short-float double-float long-float)
nconc
(and (not (subtypep 'single-float type))
(with-standard-io-syntax
(let ((*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)))))))
nil)
(deftest print.single-float.4
(let ((chars *possible-single-float-exponent-markers*))
(loop for type in '(short-float double-float long-float)
nconc
(and (not (subtypep 'single-float type))
(with-standard-io-syntax
(let ((*read-default-float-format* type))
(loop for i = (- (random 20000001) 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 f) ;; not enough bits
(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)))))))
nil)
(deftest print.single-float.random
(let ((lower-bound (if (< (log least-positive-single-float 10) -100)
(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)))
(loop for f = lower-bound then (* 10 f)
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))))
nil)
;;; double float
(deftest print.double-float.1
(with-standard-io-syntax
(let ((*read-default-float-format* 'double-float))
(loop for i from -4000 to 4000
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))))
nil)
(deftest print.double-float.2
(with-standard-io-syntax
(let ((*read-default-float-format* 'double-float))
(loop for i = (- (random 20000001) 10000000)
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 f) (equalp s1 s2)) ;; not enough bits
collect (list i f s1 s2))))
nil)
(defparameter *possible-double-float-exponent-markers*
(loop for type in '(short-float single-float double-float long-float)
for c across "SFDL"
when (subtypep 'double-float type)
nconc (list c (char-downcase c))))
(deftest print.double-float.3
(let ((chars *possible-double-float-exponent-markers*))
(loop for type in '(short-float double-float long-float)
nconc
(and (not (subtypep 'double-float type))
(with-standard-io-syntax
(let ((*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)))))))
nil)
(deftest print.double-float.4
(let ((chars *possible-double-float-exponent-markers*))
(loop for type in '(short-float double-float long-float)
nconc
(and (not (subtypep 'double-float type))
(with-standard-io-syntax
(let ((*read-default-float-format* type))
(loop for i = (- (random 20000001) 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 f) ;; not enough bits
(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)))))))
nil)
(deftest print.double-float.random
(let ((lower-bound (if (< (log least-positive-double-float 10) -100)
(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)))
(loop for f = lower-bound then (* 10 f)
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))))
nil)
;;; long float
(deftest print.long-float.1
(with-standard-io-syntax
(let ((*read-default-float-format* 'long-float))
(loop for i from -4000 to 4000
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))))
nil)
(deftest print.long-float.2
(with-standard-io-syntax
(let ((*read-default-float-format* 'long-float))
(loop for i = (- (random 20000001) 10000000)
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 f) (equalp s1 s2)) ;; not enough bits
collect (list i f s1 s2))))
nil)
(defparameter *possible-long-float-exponent-markers*
(loop for type in '(short-float single-float double-float long-float)
for c across "SFDL"
when (subtypep 'long-float type)
nconc (list c (char-downcase c))))
(deftest print.long-float.3
(let ((chars *possible-long-float-exponent-markers*))
(loop for type in '(short-float double-float long-float)
nconc
(and (not (subtypep 'long-float type))
(with-standard-io-syntax
(let ((*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)))))))
nil)
(deftest print.long-float.4
(let ((chars *possible-long-float-exponent-markers*))
(loop for type in '(short-float double-float long-float)
nconc
(and (not (subtypep 'long-float type))
(with-standard-io-syntax
(let ((*read-default-float-format* type))
(loop for i = (- (random 20000001) 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 f) ;; not enough bits
(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)))))))
nil)
(deftest print.long-float.random
(let ((lower-bound (if (< (log least-positive-long-float 10) -100)
(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)))
(loop for f = lower-bound then (* 10 f)
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)
\ No newline at end of file
......@@ -22,6 +22,7 @@
;;; argument TEST is used to compared the reread object and obj.
(defun randomly-check-readability (obj &key (test #'equal))
(declare (type function test))
;; Generate random printer-control values
(with-standard-io-syntax
(let ((*print-array* (coin))
......@@ -38,6 +39,9 @@
(*print-pretty* (coin))
(*print-right-margin* (and (coin) (random 100)))
(*print-readably* t)
(*read-default-float-format* (rcase (1 'short-float) (1 'single-float)
(1 'double-float) (1 'long-float)
(1 *read-default-float-format*)))
)
(let* ((str (with-output-to-string (s) (write obj :stream s)))
(obj2 (let ((*read-base* *print-base*))
......@@ -59,6 +63,6 @@
(list '*print-lines* *print-lines*)
(list '*print-miser-width* *print-miser-width*)
(list '*print-pretty* *print-pretty*)
(list '*print-right-margin* *print-right-margin*))))))))
(list '*print-right-margin* *print-right-margin*)
(list '*read-default-float-format* *read-default-float-format*)
)))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment