From ea0a7cdfb58ae5cce4b848290678f54d1600ac41 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 31 Jul 2008 20:45:17 +0000
Subject: [PATCH] add divide-by-zero tests for div, mod, etc.

svn: r11014
---
 collects/tests/r6rs/arithmetic/fixnums.sls |  7 +++++++
 collects/tests/r6rs/arithmetic/flonums.sls | 21 +++++++++++++++++++++
 collects/tests/r6rs/base.sls               | 17 +++++++++++++++++
 3 files changed, 45 insertions(+)

diff --git a/collects/tests/r6rs/arithmetic/fixnums.sls b/collects/tests/r6rs/arithmetic/fixnums.sls
index 48977a9052..d00fb333d8 100644
--- a/collects/tests/r6rs/arithmetic/fixnums.sls
+++ b/collects/tests/r6rs/arithmetic/fixnums.sls
@@ -220,6 +220,13 @@
 
     (test/values (fxdiv0-and-mod0 -123 10) -12 -3)
 
+    (test/exn (fxdiv 1 0) &assertion)
+    (test/exn (fxmod 1 0) &assertion)
+    (test/exn (fxdiv-and-mod 1 0) &assertion)
+    (test/exn (fxdiv0 1 0) &assertion)
+    (test/exn (fxmod0 1 0) &assertion)
+    (test/exn (fxdiv0-and-mod0 1 0) &assertion)
+
     (test (fxnot 0) -1)
     (test (fxnot -2) 1)
     (test (fxnot 1) -2)
diff --git a/collects/tests/r6rs/arithmetic/flonums.sls b/collects/tests/r6rs/arithmetic/flonums.sls
index b8fe25b657..7884e2c1ad 100644
--- a/collects/tests/r6rs/arithmetic/flonums.sls
+++ b/collects/tests/r6rs/arithmetic/flonums.sls
@@ -13,6 +13,19 @@
     (proc -inf.0)
     (proc +nan.0))
 
+  (define-syntax try-bad-divs
+    (syntax-rules ()
+      [(_ op)
+       'nothing
+       ;; The spec is unclear whether the following
+       ;; are allowed to raise exceptions.
+       #;
+       (begin
+         (test/unspec (op 1.0 0.0))
+         (test/unspec (op +inf.0 1.0))
+         (test/unspec (op -inf.0 1.0))
+         (test/unspec (op +nan.0 1.0)))]))
+
   (define (run-arithmetic-flonums-tests)
 
     (test (fl=? +inf.0 +inf.0)            #t)
@@ -209,6 +222,10 @@
 
     (test/values (fldiv-and-mod -123.0 10.0) -13.0 7.0)
 
+    (try-bad-divs fldiv)
+    (try-bad-divs flmod)
+    (try-bad-divs fldiv-and-mod)
+
     (test (fldiv0 123.0 10.0) 12.0)
     (test (flmod0 123.0 10.0) 3.0)
     (test (fldiv0 123.0 -10.0) -12.0)
@@ -220,6 +237,10 @@
 
     (test/values (fldiv0-and-mod0 -123.0 10.0) -12.0 -3.0)
 
+    (try-bad-divs fldiv0)
+    (try-bad-divs flmod0)
+    (try-bad-divs fldiv0-and-mod0)
+
     (test (flfloor 3.1) 3.0)
     (test (flfloor -3.1) -4.0)
     (test (flceiling 3.1) 4.0)
diff --git a/collects/tests/r6rs/base.sls b/collects/tests/r6rs/base.sls
index ae4a8b6b19..006b3a5a6c 100644
--- a/collects/tests/r6rs/base.sls
+++ b/collects/tests/r6rs/base.sls
@@ -58,6 +58,16 @@
          (test (< (mod0 x1 x2) (abs (/ x2 2))) #t)
          (test (+ (* (div0 x1 x2) x2) (mod0 x1 x2)) x1))]))
 
+  (define-syntax try-bad-divs
+    (syntax-rules ()
+      [(_ op)
+       (begin
+         (test/exn (op 1 0) &assertion)
+         (test/exn (op 1 0.0) &assertion)
+         (test/exn (op +inf.0 1) &assertion)
+         (test/exn (op -inf.0 1) &assertion)
+         (test/exn (op +nan.0 1) &assertion))]))
+
   (define-syntax test-string-to-number
     (syntax-rules ()
       [(_ [str num] ...) (begin (test (string->number str) num) ...)]))
@@ -783,6 +793,13 @@
     (divmod-test/? -17.0 +inf.0)
     (divmod-test/? -17.0 -inf.0)
 
+    (try-bad-divs div)
+    (try-bad-divs mod)
+    (try-bad-divs div-and-mod)
+    (try-bad-divs div0)
+    (try-bad-divs mod0)
+    (try-bad-divs div0-and-mod0)
+
     (test (gcd 32 -36)                            4)
     (test (gcd)                                   0)
     (test (lcm 32 -36)                            288)