From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 8 Nov 2018 08:09:47 +0000 (+0000)
Subject: Test edge cases of flonum-divide primitive and of atan.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~116^2~12
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f9ba5759a1b19ae829833a35406fd551bd3809b4;p=mit-scheme.git

Test edge cases of flonum-divide primitive and of atan.
---

diff --git a/tests/microcode/test-flonum-except.scm b/tests/microcode/test-flonum-except.scm
index 6c611d0e2..3c5475b3e 100644
--- a/tests/microcode/test-flonum-except.scm
+++ b/tests/microcode/test-flonum-except.scm
@@ -173,6 +173,12 @@ USA.
   (applicator flo:- (flo:-inf.0) (flo:-inf.0)))
 (define-invop-flag-test 'flonum-divide (applicator flo:/ 0. 0.)) ;(e)
 (define-invop-trap-test 'flonum-divide (applicator flo:/ 0. 0.)) ;(e)
+(define-invop-flag-test 'flonum-divide                           ;(e)
+  (applicator (make-primitive-procedure 'flonum-divide) 0. 0.)
+  'xerror)
+(define-invop-trap-test 'flonum-divide                           ;(e)
+  (applicator (make-primitive-procedure 'flonum-divide) 0. 0.)
+  'xerror)
 ;; XXX remainder ;(f)
 (define-invop-flag-test 'flonum-sqrt (applicator flo:sqrt -1.))	;(g)
 (define-invop-trap-test 'flonum-sqrt (applicator flo:sqrt -1.))	;(g)
@@ -187,6 +193,12 @@ USA.
 ;; XXX Check sign of infinity.
 (define-divbyzero-flag-test 'flonum-divide (applicator flo:/ 1. 0.))
 (define-divbyzero-trap-test 'flonum-divide (applicator flo:/ 1. 0.))
+(define-divbyzero-flag-test 'flonum-divide
+  (applicator (make-primitive-procedure 'flonum-divide) 1. 0.)
+  'xerror)
+(define-divbyzero-trap-test 'flonum-divide
+  (applicator (make-primitive-procedure 'flonum-divide) 1. 0.)
+  'xerror)
 (define-divbyzero-flag-test 'flonum-log (applicator flo:log 0.))
 (define-divbyzero-trap-test 'flonum-log (applicator flo:log 0.))
 
diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index ff82933ce..69de63375 100644
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -333,4 +333,25 @@ USA.
           ;; For all the inputs, reciprocal is exact.
           (assert-eqv (expt (/ 1 x) (- y)) x^y)
           (assert-eqv (expt (* 2 x) (/ y 2)) x^y)
-          (assert-eqv (expt (/ 1 (* 2 x)) (- (/ y 2))) x^y))))))
\ No newline at end of file
+          (assert-eqv (expt (/ 1 (* 2 x)) (- (/ y 2))) x^y))))))
+
+(define-enumerated-test 'atan2
+  (vector
+   (vector +0. -1. (+ (atan 0 -1)))
+   (vector -0. -1. (- (atan 0 -1)))
+   (vector +0. -0. (+ (atan 0 -1)))
+   (vector -0. -0. (- (atan 0 -1)))
+   (vector +0. +0. +0.)
+   (vector -0. +0. -0.)
+   (vector +0. +1. +0.)
+   (vector -0. +1. -0.))
+  (lambda (v)
+    (let ((y (vector-ref v 0))
+          (x (vector-ref v 1))
+          (theta (vector-ref v 2)))
+      (define (body)
+        (assert-eqv (atan y x) theta))
+      (if (and (= y 0) (= x 0))
+          ;; XXX expected failure
+          (assert-error body)
+          (body)))))
\ No newline at end of file