(library (tests fixnums) (export test-fxdiv-and-mod test-fxdiv0-and-mod0 test-fxlength) (import (ikarus)) (define (test-fxdiv-and-mod) (define (test x1 x2) (let-values ([(d m) (fxdiv-and-mod x1 x2)]) (printf "(fxdiv-and-mod ~s ~s) = ~s ~s\n" x1 x2 d m) (assert (= d (fxdiv x1 x2))) (assert (= m (fxmod x1 x2))) (assert (<= 0 m)) (assert (< m (abs x2))) (assert (= x1 (+ (* d x2) m))))) (test +17 +3) (test +17 -3) (test -17 +3) (test -17 -3) (test +16 +3) (test +16 -3) (test -16 +3) (test -16 -3) (test +15 +3) (test +15 -3) (test -15 +3) (test -15 -3) (test +10 +4) (test +10 -4) (test -10 +4) (test -10 -4)) (define (test-fxdiv0-and-mod0) (define (test x1 x2) (let-values ([(d m) (fxdiv0-and-mod0 x1 x2)]) (printf "(fxdiv0-and-mod0 ~s ~s) = ~s ~s\n" x1 x2 d m) (assert (= d (fxdiv0 x1 x2))) (assert (= m (fxmod0 x1 x2))) (assert (<= (- (abs (/ x2 2))) m)) (assert (< m (abs (/ x2 2)))) (assert (= x1 (+ (* d x2) m))))) (test +17 +3) (test +17 -3) (test -17 +3) (test -17 -3) (test +16 +3) (test +16 -3) (test -16 +3) (test -16 -3) (test +15 +3) (test +15 -3) (test -15 +3) (test -15 -3) (test +10 +4) (test +10 -4) (test -10 +4) (test -10 -4) (test (least-fixnum) +1) ;(test (least-fixnum) -1) ;; overflows (test (greatest-fixnum) +1) (test (greatest-fixnum) -1) (test (least-fixnum) +2) (test (least-fixnum) -2) (test (greatest-fixnum) +2) (test (greatest-fixnum) -2) (test 0 (least-fixnum)) (test 0 (greatest-fixnum)) (test +1 (least-fixnum)) (test +1 (greatest-fixnum)) (test -1 (least-fixnum)) (test -1 (greatest-fixnum)) (test +2 (least-fixnum)) (test +2 (greatest-fixnum)) (test -2 (least-fixnum)) (test -2 (greatest-fixnum)) (test (least-fixnum) (least-fixnum)) (test (greatest-fixnum) (least-fixnum)) (test (least-fixnum) (greatest-fixnum)) (test (greatest-fixnum) (greatest-fixnum))) (define (test-fxlength) (define (test x) (define (bitlen x) (if (zero? x) 0 (+ 1 (bitlen (bitwise-arithmetic-shift-right x 1))))) (define (len x) (if (< x 0) (bitlen (bitwise-not x)) (bitlen x))) (let ([c0 (len x)] [c1 (fxlength x)]) (unless (= c0 c1) (error 'test-fxlength "failed/expected/got" x c0 c1)))) (define (fxtest x) (when (fixnum? x) (when (zero? (bitwise-and x #xFFFFFFF)) (printf "fxlength ~s\n" x)) (test x) (fxtest (+ x #x100)))) (test 0) (test 1) (test 2) (test 3) (test -1) (test -2) (test -3) (fxtest (least-fixnum))) )