ikarus/scheme/tests/fxcarry.ss

62 lines
1.7 KiB
Scheme
Raw Normal View History

(library (tests fxcarry)
(export test-fxcarry)
(import (ikarus) (tests framework))
(define (fx*/carry-reference fx1 fx2 fx3)
(let* ([s (+ (* fx1 fx2) fx3)]
[s0 (mod0 s (expt 2 (fixnum-width)))]
[s1 (div0 s (expt 2 (fixnum-width)))])
(values s0 s1)))
(define (fx+/carry-reference fx1 fx2 fx3)
(let* ([s (+ (+ fx1 fx2) fx3)]
[s0 (mod0 s (expt 2 (fixnum-width)))]
[s1 (div0 s (expt 2 (fixnum-width)))])
(values s0 s1)))
(define (fx-/carry-reference fx1 fx2 fx3)
(let* ([s (- (- fx1 fx2) fx3)]
[s0 (mod0 s (expt 2 (fixnum-width)))]
[s1 (div0 s (expt 2 (fixnum-width)))])
(values s0 s1)))
(define (test name fxop/carry fxop/carry-reference fx1 fx2 fx3)
(let-values ([(s0 s1) (fxop/carry fx1 fx2 fx3)]
[(s2 s3) (fxop/carry-reference fx1 fx2 fx3)])
(unless (fx= s0 s2)
(error name "failed (value1) on ~s ~s ~s, got ~s, should be ~s"
fx1 fx2 fx3 s0 s2))
(unless (fx= s1 s3)
(error name "failed (value2) on ~s ~s ~s, got ~s, should be ~s"
fx1 fx2 fx3 s1 s3))))
(define ls
(list 0 1 2 -1 -2 38734 -3843 2484598 -348732487 (greatest-fixnum) (least-fixnum)))
(define (test-fxcarry)
(printf "[~s: test-fxcarry] " (expt (length ls) 3))
(for-each
(lambda (fx1)
(for-each
(lambda (fx2)
(for-each
(lambda (fx3)
(test 'fx*/carry fx*/carry fx*/carry-reference fx1 fx2 fx3)
(test 'fx+/carry fx+/carry fx+/carry-reference fx1 fx2 fx3)
(test 'fx-/carry fx-/carry fx-/carry-reference fx1 fx2 fx3))
ls))
ls))
ls)
(printf "Happy Happy Joy Joy\n"))
)
#!eof
(define (t x)
(= (fxsra (fx+ x 1) 1)
(quotient x 2)))