ikarus/scheme/tests/fldiv-and-mod.ss

(library (tests fldiv-and-mod)
  (export run-tests)
  (import (ikarus))

  (define (run-tests)
    (test-fldiv-and-mod)
    (test-fldiv0-and-mod0))


  (define (test-fldiv-and-mod)
    (define (test x1 x2 verify?)
      (let-values ([(d m) (fldiv-and-mod x1 x2)])
        (printf "(fldiv-and-mod ~s ~s) = ~s ~s\n" x1 x2 d m)
        (when verify?
          (assert (= d (fldiv x1 x2)))
          (assert (= m (flmod x1 x2)))
          (assert (<= 0.0 m))
          (assert (< m (abs x2)))
          (assert (= x1 (+ (* d x2) m))))))
    (test +17.0 +3.0 #t)
    (test +17.0 -3.0 #t)
    (test -17.0 +3.0 #t)
    (test -17.0 -3.0 #t)
    (test +16.0 +3.0 #t)
    (test +16.0 -3.0 #t)
    (test -16.0 +3.0 #t)
    (test -16.0 -3.0 #t)
    (test +15.0 +3.0 #t)
    (test +15.0 -3.0 #t)
    (test -15.0 +3.0 #t)
    (test -15.0 -3.0 #t)
    (test +17.0 +3.5 #t)
    (test +17.0 -3.5 #t)
    (test -17.0 +3.5 #t)
    (test -17.0 -3.5 #t)
    (test +16.0 +3.5 #t)
    (test +16.0 -3.5 #t)
    (test -16.0 +3.5 #t)
    (test -16.0 -3.5 #t)
    (test +15.0 +3.5 #t)
    (test +15.0 -3.5 #t)
    (test -15.0 +3.5 #t)
    (test -15.0 -3.5 #t)
    (test +17.0 +nan.0 #f)
    (test -17.0 +nan.0 #f)
    (test +17.0 +inf.0 #f)
    (test +17.0 -inf.0 #f)
    (test -17.0 +inf.0 #f)
    (test -17.0 -inf.0 #f))

  (define (test-fldiv0-and-mod0)
    (define (test x1 x2 verify?)
      (let-values ([(d m) (fldiv0-and-mod0 x1 x2)])
        (printf "(fldiv0-and-mod0 ~s ~s) = ~s ~s\n" x1 x2 d m)
        (when verify?
          (assert (= d (fldiv0 x1 x2)))
          (assert (= m (flmod0 x1 x2)))
          (assert (<= (fl- (flabs (fl/ x2 2.0))) m))
          (assert (< m (flabs (fl/ x2 2.0))))
          (assert (= x1 (+ (* d x2) m))))))
    (test +17.0 +3.0 #t)
    (test +17.0 -3.0 #t)
    (test -17.0 +3.0 #t)
    (test -17.0 -3.0 #t)
    (test +16.0 +3.0 #t)
    (test +16.0 -3.0 #t)
    (test -16.0 +3.0 #t)
    (test -16.0 -3.0 #t)
    (test +15.0 +3.0 #t)
    (test +15.0 -3.0 #t)
    (test -15.0 +3.0 #t)
    (test -15.0 -3.0 #t)
    (test +17.0 +3.5 #t)
    (test +17.0 -3.5 #t)
    (test -17.0 +3.5 #t)
    (test -17.0 -3.5 #t)
    (test +16.0 +3.5 #t)
    (test +16.0 -3.5 #t)
    (test -16.0 +3.5 #t)
    (test -16.0 -3.5 #t)
    (test +15.0 +3.5 #t)
    (test +15.0 -3.5 #t)
    (test -15.0 +3.5 #t)
    (test -15.0 -3.5 #t)
    (test +10.0 +4.0 #t)
    (test +10.0 -4.0 #t)
    (test -10.0 +4.0 #t)
    (test -10.0 -4.0 #t)
    (test +17.0 +nan.0 #f)
    (test -17.0 +nan.0 #f)
    (test +17.0 +inf.0 #f)
    (test +17.0 -inf.0 #f)
    (test -17.0 +inf.0 #f)
    (test -17.0 -inf.0 #f))
  )