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

Fix edge cases of flonum divide and atan2.
---

diff --git a/src/microcode/flonum.c b/src/microcode/flonum.c
index cf150a256..e0c1bfd1e 100644
--- a/src/microcode/flonum.c
+++ b/src/microcode/flonum.c
@@ -68,17 +68,8 @@ DEFINE_PRIMITIVE ("FLONUM-SUBTRACT", Prim_flonum_subtract, 2, 2, 0)
      FLONUM_BINARY_OPERATION (-)
 DEFINE_PRIMITIVE ("FLONUM-MULTIPLY", Prim_flonum_multiply, 2, 2, 0)
      FLONUM_BINARY_OPERATION (*)
-
 DEFINE_PRIMITIVE ("FLONUM-DIVIDE", Prim_flonum_divide, 2, 2, 0)
-{
-  PRIMITIVE_HEADER (2);
-  {
-    double denominator = (arg_flonum (2));
-    if (denominator == 0)
-      error_bad_range_arg (2);
-    FLONUM_RESULT ((arg_flonum (1)) / denominator);
-  }
-}
+     FLONUM_BINARY_OPERATION (/)
 
 DEFINE_PRIMITIVE ("FLONUM-MODULO", Prim_flonum_modulo, 2, 2, 0)
 #ifdef HAVE_FMOD
@@ -226,8 +217,6 @@ DEFINE_PRIMITIVE ("FLONUM-ATAN2", Prim_flonum_atan2, 2, 2, 0)
   {
     double y = (arg_flonum (1));
     double x = (arg_flonum (2));
-    if ((x == 0) && (y == 0))
-      error_bad_range_arg (2);
     FLONUM_RESULT (atan2 (y, x));
   }
 }
diff --git a/tests/microcode/test-flonum-except.scm b/tests/microcode/test-flonum-except.scm
index 3c5475b3e..2eb0a1608 100644
--- a/tests/microcode/test-flonum-except.scm
+++ b/tests/microcode/test-flonum-except.scm
@@ -174,11 +174,9 @@ USA.
 (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)
+  (applicator (make-primitive-procedure 'flonum-divide) 0. 0.))
 (define-invop-trap-test 'flonum-divide                           ;(e)
-  (applicator (make-primitive-procedure 'flonum-divide) 0. 0.)
-  'xerror)
+  (applicator (make-primitive-procedure 'flonum-divide) 0. 0.))
 ;; 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)
@@ -194,11 +192,9 @@ USA.
 (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)
+  (applicator (make-primitive-procedure 'flonum-divide) 1. 0.))
 (define-divbyzero-trap-test 'flonum-divide
-  (applicator (make-primitive-procedure 'flonum-divide) 1. 0.)
-  'xerror)
+  (applicator (make-primitive-procedure 'flonum-divide) 1. 0.))
 (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 69de63375..ea3dfe836 100644
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -349,9 +349,4 @@ USA.
     (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
+      (assert-eqv (atan y x) theta))))
\ No newline at end of file