Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
ansi-test
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Karsten Poeck
ansi-test
Commits
41e455d5
Commit
41e455d5
authored
Mar 03, 2004
by
pfdietz
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added tests for printing floating point numbers.
parent
1830535c
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
364 additions
and
3 deletions
+364
-3
ansi-tests/load-printer.lsp
ansi-tests/load-printer.lsp
+1
-0
ansi-tests/print-floats.lsp
ansi-tests/print-floats.lsp
+356
-0
ansi-tests/printer-aux.lsp
ansi-tests/printer-aux.lsp
+7
-3
No files found.
ansi-tests/load-printer.lsp
View file @
41e455d5
...
...
@@ -11,4 +11,5 @@
(load "print-integers.lsp")
(load "print-ratios.lsp")
(load "print-floats.lsp")
ansi-tests/print-floats.lsp
0 → 100644
View file @
41e455d5
;-*- 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
ansi-tests/printer-aux.lsp
View file @
41e455d5
...
...
@@ -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*)
)))))))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment