From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 29 Nov 2018 02:54:45 +0000 (+0000)
Subject: Move a bunch of flonum tests to test-flonum.scm.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~124
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=bcc943f04606b34922cba8fbaae09ecbc8a6f0ad;p=mit-scheme.git

Move a bunch of flonum tests to test-flonum.scm.

Let's keep test-arith.scm for higher-level numerical computations.
---

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index bc5c24310..ccc6a15ed 100644
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -35,15 +35,6 @@ USA.
   (assert-true (flo:flonum? object))
   (assert-true (flo:nan? object)))
 
-(define (assert-zero object)
-  (assert-= object 0))
-
-(define (assert-zero+ object)
-  (assert-eqv object 0.))
-
-(define (assert-zero- object)
-  (assert-eqv object -0.))
-
 (define (assert-inf- object)
   (assert-eqv object (flo:-inf.0)))
 
@@ -56,9 +47,6 @@ USA.
 (define assert-integer
   (predicate-assertion integer? "integer"))
 
-(define assert-exact-integer
-  (predicate-assertion exact-integer? "integer"))
-
 (define assert-not-integer
   (predicate-assertion not-integer? "not integer"))
 
@@ -68,12 +56,6 @@ USA.
 (define assert-real
   (predicate-assertion real? "real number"))
 
-(define assert-normal
-  (predicate-assertion flo:normal? "normal floating-point number"))
-
-(define assert-subnormal
-  (predicate-assertion flo:subnormal? "subnormal floating-point number"))
-
 (define (with-expected-failure xfail body)
   (if (default-object? xfail)
       (body)
@@ -217,29 +199,6 @@ USA.
   (lambda ()
     (assert-nan (make-polar (flo:nan.0) 0))))
 
-(define-enumerated-test 'flo:ulp
-  (list
-   (list (flo:-inf.0) (flo:+inf.0))
-   (list (+ -3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one))
-   (list -3. (* 2 flo:ulp-of-one))
-   (list -2. (* 2 flo:ulp-of-one))
-   (list -1. flo:ulp-of-one)
-   (list -0. "4.9406564584124654e-324")
-   (list 0. "4.9406564584124654e-324")
-   (list 1. flo:ulp-of-one)
-   (list 2. (* 2 flo:ulp-of-one))
-   (list 3. (* 2 flo:ulp-of-one))
-   (list (- 3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one))
-   (list (flo:+inf.0) (flo:+inf.0)))
-  (lambda (x u)
-    (flo:with-trapped-exceptions 0
-      (lambda ()
-        (let ((u
-               (if (string? u)
-                   (string->number u)
-                   u)))
-          (assert-eqv (flo:ulp x) u))))))
-
 (define-enumerated-test 'log1p-exact
   (list
    (list 0 0)
@@ -630,98 +589,6 @@ USA.
       (lambda ()
         (assert-<= (relerr t (atan x)) 1e-15)))))
 
-(define-test 'radix
-  (lambda ()
-    (assert-exact-integer flo:radix)
-    (assert-flonum flo:radix.)
-    (assert-= flo:radix flo:radix.)))
-
-(define-test 'error-ulp
-  (lambda ()
-    (assert-flonum flo:ulp-of-one)
-    (assert-flonum flo:error-bound)
-    (assert-> flo:ulp-of-one 0)
-    (assert-< flo:ulp-of-one 1)
-    (assert-= (/ flo:ulp-of-one 2) flo:error-bound)))
-
-(define-test 'exponents
-  (lambda ()
-    (assert-exact-integer flo:normal-exponent-max)
-    (assert-exact-integer flo:normal-exponent-min)
-    (assert-exact-integer flo:subnormal-exponent-min)))
-
-(define-test 'extremes
-  (lambda ()
-    (assert-flonum flo:smallest-positive-subnormal)
-    (assert-flonum flo:smallest-positive-normal)
-    (assert-flonum flo:largest-positive-normal)
-    (assert-eqv flo:smallest-positive-subnormal
-                (flo:scalbn 1. flo:subnormal-exponent-min))
-    (assert-eqv flo:smallest-positive-normal
-                (flo:scalbn 1. flo:normal-exponent-min))
-    (assert-eqv flo:largest-positive-normal
-                (flo:scalbn (- flo:radix. flo:ulp-of-one)
-                            flo:normal-exponent-max))
-    (assert-subnormal flo:smallest-positive-subnormal)
-    (assert-zero+ (flo:nextafter flo:smallest-positive-subnormal (flo:-inf.0)))
-    (assert-normal flo:smallest-positive-normal)
-    (assert-subnormal
-     (flo:nextafter flo:smallest-positive-normal (flo:-inf.0)))
-    (assert-normal flo:largest-positive-normal)
-    (assert-inf+ (flo:nextafter flo:largest-positive-normal (flo:+inf.0)))))
-
-(define-test 'least-subnormal-exponents
-  (lambda ()
-    (assert-flonum flo:least-subnormal-exponent-base-2)
-    (assert-flonum flo:least-subnormal-exponent-base-e)
-    (assert-flonum flo:least-subnormal-exponent-base-10)
-    (assert-subnormal (expt 2. flo:least-subnormal-exponent-base-2))
-    (assert-subnormal (exp flo:least-subnormal-exponent-base-e))
-    (assert-subnormal (expt 10. flo:least-subnormal-exponent-base-10))
-    (assert-zero+
-     (expt 2.
-           (flo:nextafter flo:least-subnormal-exponent-base-2 (flo:-inf.0))))
-    (assert-zero+
-     (exp (flo:nextafter flo:least-subnormal-exponent-base-e (flo:-inf.0))))
-    (assert-zero+
-     (expt 10.
-           (flo:nextafter flo:least-subnormal-exponent-base-10
-                          (flo:-inf.0))))))
-
-(define-test 'least-normal-exponents
-  (lambda ()
-    (assert-flonum flo:least-normal-exponent-base-2)
-    (assert-flonum flo:least-normal-exponent-base-e)
-    (assert-flonum flo:least-normal-exponent-base-10)
-    (assert-normal (expt 2. flo:least-normal-exponent-base-2))
-    (assert-normal (exp flo:least-normal-exponent-base-e))
-    (assert-normal (expt 10. flo:least-normal-exponent-base-10))
-    (assert-subnormal
-     (expt 2.
-           (flo:nextafter flo:least-normal-exponent-base-2 (flo:-inf.0))))
-    (assert-subnormal
-     (exp (flo:nextafter flo:least-normal-exponent-base-e (flo:-inf.0))))
-    (assert-subnormal
-     (expt 10.
-           (flo:nextafter flo:least-normal-exponent-base-10 (flo:-inf.0))))))
-
-(define-test 'greatest-normal-exponents
-  (lambda ()
-    (assert-flonum flo:greatest-normal-exponent-base-2)
-    (assert-flonum flo:greatest-normal-exponent-base-e)
-    (assert-flonum flo:greatest-normal-exponent-base-10)
-    (assert-normal (expt 2. flo:greatest-normal-exponent-base-2))
-    (assert-normal (exp flo:greatest-normal-exponent-base-e))
-    (assert-normal (expt 10. flo:greatest-normal-exponent-base-10))
-    (assert-inf+
-     (expt 2.
-           (flo:nextafter flo:greatest-normal-exponent-base-2 (flo:+inf.0))))
-    (assert-inf+
-     (exp (flo:nextafter flo:greatest-normal-exponent-base-e (flo:+inf.0))))
-    (assert-inf+
-     (expt 10.
-           (flo:nextafter flo:greatest-normal-exponent-base-2 (flo:+inf.0))))))
-
 (define-enumerated-test 'infinite-magnitude
   (list
    (list +inf.0)
@@ -758,18 +625,4 @@ USA.
    (list -inf.0-inf.0i (* pi -3/4))
    (list -inf.0+inf.0i (* pi 3/4)))
   (lambda (z t)
-    (assert-<= (relerr t (angle z)) 1e-15)))
-
-(define-enumerated-test 'flo:classify
-  `((0. zero)
-    (-0. zero)
-    (,(flo:nextafter 0. 1.) subnormal)
-    (,flo:smallest-positive-subnormal subnormal)
-    (,flo:smallest-positive-normal normal)
-    (1. normal)
-    (+inf.0 infinite)
-    (-inf.0 infinite)
-    (+nan.0 nan)
-    (-nan.0 nan))
-  (lambda (x c)
-    (assert-eq (flo:classify x) c)))
\ No newline at end of file
+    (assert-<= (relerr t (angle z)) 1e-15)))
\ No newline at end of file
diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index 0ce0b0c92..5777efc97 100644
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -35,9 +35,24 @@ USA.
              (apply procedure arguments)))
          cases)))
 
+(define assert-exact-integer
+  (predicate-assertion exact-integer? "integer"))
+
 (define assert-flonum
   (predicate-assertion flo:flonum? "flonum"))
 
+(define (assert-zero- object)
+  (assert-eqv object -0.))
+
+(define (assert-zero+ object)
+  (assert-eqv object 0.))
+
+(define (assert-inf- object)
+  (assert-eqv object (flo:-inf.0)))
+
+(define (assert-inf+ object)
+  (assert-eqv object (flo:+inf.0)))
+
 (define assert-nan
   (predicate-assertion flo:nan? "NaN"))
 
@@ -47,6 +62,12 @@ USA.
 (define assert-snan
   (predicate-assertion flo:snan? "sNaN"))
 
+(define assert-normal
+  (predicate-assertion flo:normal? "normal floating-point number"))
+
+(define assert-subnormal
+  (predicate-assertion flo:subnormal? "subnormal floating-point number"))
+
 (define (eqv-nan? x y)
   (if (flo:nan? x)
       (and (flo:nan? y)
@@ -80,6 +101,121 @@ USA.
 (define subnormal+ flo:smallest-positive-subnormal)
 (define subnormal- (no-traps (lambda () (- subnormal+))))
 
+(define-test 'radix
+  (lambda ()
+    (assert-exact-integer flo:radix)
+    (assert-flonum flo:radix.)
+    (assert-= flo:radix flo:radix.)))
+
+(define-test 'error-ulp
+  (lambda ()
+    (assert-flonum flo:ulp-of-one)
+    (assert-flonum flo:error-bound)
+    (assert-> flo:ulp-of-one 0)
+    (assert-< flo:ulp-of-one 1)
+    (assert-= (/ flo:ulp-of-one 2) flo:error-bound)))
+
+(define-test 'exponents
+  (lambda ()
+    (assert-exact-integer flo:normal-exponent-max)
+    (assert-exact-integer flo:normal-exponent-min)
+    (assert-exact-integer flo:subnormal-exponent-min)))
+
+(define-test 'extremes
+  (lambda ()
+    (assert-flonum flo:smallest-positive-subnormal)
+    (assert-flonum flo:smallest-positive-normal)
+    (assert-flonum flo:largest-positive-normal)
+    (assert-eqv flo:smallest-positive-subnormal
+                (flo:scalbn 1. flo:subnormal-exponent-min))
+    (assert-eqv flo:smallest-positive-normal
+                (flo:scalbn 1. flo:normal-exponent-min))
+    (assert-eqv flo:largest-positive-normal
+                (flo:scalbn (- flo:radix. flo:ulp-of-one)
+                            flo:normal-exponent-max))
+    (assert-subnormal flo:smallest-positive-subnormal)
+    (assert-zero+ (flo:nextafter flo:smallest-positive-subnormal (flo:-inf.0)))
+    (assert-normal flo:smallest-positive-normal)
+    (assert-subnormal
+     (flo:nextafter flo:smallest-positive-normal (flo:-inf.0)))
+    (assert-normal flo:largest-positive-normal)
+    (assert-inf+ (flo:nextafter flo:largest-positive-normal (flo:+inf.0)))))
+
+(define-test 'least-subnormal-exponents
+  (lambda ()
+    (assert-flonum flo:least-subnormal-exponent-base-2)
+    (assert-flonum flo:least-subnormal-exponent-base-e)
+    (assert-flonum flo:least-subnormal-exponent-base-10)
+    (assert-subnormal (expt 2. flo:least-subnormal-exponent-base-2))
+    (assert-subnormal (exp flo:least-subnormal-exponent-base-e))
+    (assert-subnormal (expt 10. flo:least-subnormal-exponent-base-10))
+    (assert-zero+
+     (expt 2.
+           (flo:nextafter flo:least-subnormal-exponent-base-2 (flo:-inf.0))))
+    (assert-zero+
+     (exp (flo:nextafter flo:least-subnormal-exponent-base-e (flo:-inf.0))))
+    (assert-zero+
+     (expt 10.
+           (flo:nextafter flo:least-subnormal-exponent-base-10
+                          (flo:-inf.0))))))
+
+(define-test 'least-normal-exponents
+  (lambda ()
+    (assert-flonum flo:least-normal-exponent-base-2)
+    (assert-flonum flo:least-normal-exponent-base-e)
+    (assert-flonum flo:least-normal-exponent-base-10)
+    (assert-normal (expt 2. flo:least-normal-exponent-base-2))
+    (assert-normal (exp flo:least-normal-exponent-base-e))
+    (assert-normal (expt 10. flo:least-normal-exponent-base-10))
+    (assert-subnormal
+     (expt 2.
+           (flo:nextafter flo:least-normal-exponent-base-2 (flo:-inf.0))))
+    (assert-subnormal
+     (exp (flo:nextafter flo:least-normal-exponent-base-e (flo:-inf.0))))
+    (assert-subnormal
+     (expt 10.
+           (flo:nextafter flo:least-normal-exponent-base-10 (flo:-inf.0))))))
+
+(define-test 'greatest-normal-exponents
+  (lambda ()
+    (assert-flonum flo:greatest-normal-exponent-base-2)
+    (assert-flonum flo:greatest-normal-exponent-base-e)
+    (assert-flonum flo:greatest-normal-exponent-base-10)
+    (assert-normal (expt 2. flo:greatest-normal-exponent-base-2))
+    (assert-normal (exp flo:greatest-normal-exponent-base-e))
+    (assert-normal (expt 10. flo:greatest-normal-exponent-base-10))
+    (assert-inf+
+     (expt 2.
+           (flo:nextafter flo:greatest-normal-exponent-base-2 (flo:+inf.0))))
+    (assert-inf+
+     (exp (flo:nextafter flo:greatest-normal-exponent-base-e (flo:+inf.0))))
+    (assert-inf+
+     (expt 10.
+           (flo:nextafter flo:greatest-normal-exponent-base-2 (flo:+inf.0))))))
+
+(define-enumerated-test 'flo:ulp
+  (list
+   (list (flo:-inf.0) (flo:+inf.0))
+   (list (+ -3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one))
+   (list -3. (* 2 flo:ulp-of-one))
+   (list -2. (* 2 flo:ulp-of-one))
+   (list -1. flo:ulp-of-one)
+   (list -0. "4.9406564584124654e-324")
+   (list 0. "4.9406564584124654e-324")
+   (list 1. flo:ulp-of-one)
+   (list 2. (* 2 flo:ulp-of-one))
+   (list 3. (* 2 flo:ulp-of-one))
+   (list (- 3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one))
+   (list (flo:+inf.0) (flo:+inf.0)))
+  (lambda (x u)
+    (flo:with-trapped-exceptions 0
+      (lambda ()
+        (let ((u
+               (if (string? u)
+                   (string->number u)
+                   u)))
+          (assert-eqv (flo:ulp x) u))))))
+
 (define-enumerated-test 'copysign
   '((0. 0. 0.)
     (0. -0. -0.)
@@ -124,6 +260,20 @@ USA.
   (lambda (x y z)
     (assert-eqv (no-traps (lambda () (flo:nextafter x y))) z)))
 
+(define-enumerated-test 'flo:classify
+  `((0. zero)
+    (-0. zero)
+    (,(flo:nextafter 0. 1.) subnormal)
+    (,flo:smallest-positive-subnormal subnormal)
+    (,flo:smallest-positive-normal normal)
+    (1. normal)
+    (+inf.0 infinite)
+    (-inf.0 infinite)
+    (+nan.0 nan)
+    (-nan.0 nan))
+  (lambda (x c)
+    (assert-eq (flo:classify x) c)))
+
 (define-enumerated-test 'zero?
   `((-inf.0 #f)
     (-1. #f)