97 lines
2.5 KiB
Scheme
Executable File
97 lines
2.5 KiB
Scheme
Executable File
|
|
(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))
|
|
)
|