suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
a665239689
racket/collects/tests/r6rs/arithmetic/bitwise.sls
Matthew Flatt ec75a07fc6 .ss -> .sls for portable R6RS tests 
svn: r10853
2008-07-21 20:51:33 +00:00

308 lines
9.6 KiB
Scheme
Raw Blame History

#!r6rs
(library (tests r6rs arithmetic bitwise)
(export run-arithmetic-bitwise-tests)
(import (rnrs)
(tests r6rs test))
;; Helpers originally from Ikarus test suite:
(define (ref ei)
(do ((result 0 (+ result 1))
(bits (if (negative? ei)
(bitwise-not ei)
ei)
(bitwise-arithmetic-shift bits -1)))
((zero? bits)
result)))
(define-syntax len-test
(syntax-rules ()
[(_ n) (test (bitwise-length n)
(ref n))]))
(define (pos-count-bits n)
(if (zero? n)
0
(let ([c (count-bits (bitwise-arithmetic-shift-right n 1))])
(if (even? n) c (+ c 1)))))
(define (count-bits n)
(if (>= n 0)
(pos-count-bits n)
(bitwise-not (pos-count-bits (bitwise-not n)))))
(define-syntax count-test
(syntax-rules ()
[(_ n)
(test (bitwise-bit-count n) (count-bits n))]))
(define (run-arithmetic-bitwise-tests)
(test (bitwise-first-bit-set 0) -1)
(test (bitwise-first-bit-set 1) 0)
(test (bitwise-first-bit-set -4) 2)
(test (bitwise-arithmetic-shift -6 -1) -3)
(test (bitwise-arithmetic-shift -5 -1) -3)
(test (bitwise-arithmetic-shift -4 -1) -2)
(test (bitwise-arithmetic-shift -3 -1) -2)
(test (bitwise-arithmetic-shift -2 -1) -1)
(test (bitwise-arithmetic-shift -1 -1) -1)
(test (bitwise-reverse-bit-field #b1010010 1 4) 88) ; #b1011000
;; Originally from Ikarus test suite:
(len-test #xF)
(len-test #xFF)
(len-test #xFFF)
(len-test #xFFFF)
(len-test #xFFFFF)
(len-test #xFFFFFF)
(len-test #xFFFFFFF)
(len-test #xFFFFFFFF)
(len-test #xFFFFFFFFF)
(len-test #xFFFFFFFFFF)
(len-test #xFFFFFFFFFFF)
(len-test #xFFFFFFFFFFFF)
(len-test #xFFFFFFFFFFFFF)
(len-test #xFFFFFFFFFFFFFF)
(len-test #xFFFFFFFFFFFFFFF)
(len-test #xFFFFFFFFFFFFFFFF)
(len-test #x-F)
(len-test #x-FF)
(len-test #x-FFF)
(len-test #x-FFFF)
(len-test #x-FFFFF)
(len-test #x-FFFFFF)
(len-test #x-FFFFFFF)
(len-test #x-FFFFFFFF)
(len-test #x-FFFFFFFFF)
(len-test #x-FFFFFFFFFF)
(len-test #x-FFFFFFFFFFF)
(len-test #x-FFFFFFFFFFFF)
(len-test #x-FFFFFFFFFFFFF)
(len-test #x-FFFFFFFFFFFFFF)
(len-test #x-FFFFFFFFFFFFFFF)
(len-test #x-FFFFFFFFFFFFFFFF)
(len-test #xE)
(len-test #xFE)
(len-test #xFFE)
(len-test #xFFFE)
(len-test #xFFFFE)
(len-test #xFFFFFE)
(len-test #xFFFFFFE)
(len-test #xFFFFFFFE)
(len-test #xFFFFFFFFE)
(len-test #xFFFFFFFFFE)
(len-test #xFFFFFFFFFFE)
(len-test #xFFFFFFFFFFFE)
(len-test #xFFFFFFFFFFFFE)
(len-test #xFFFFFFFFFFFFFE)
(len-test #xFFFFFFFFFFFFFFE)
(len-test #xFFFFFFFFFFFFFFFE)
(len-test #x-E)
(len-test #x-FE)
(len-test #x-FFE)
(len-test #x-FFFE)
(len-test #x-FFFFE)
(len-test #x-FFFFFE)
(len-test #x-FFFFFFE)
(len-test #x-FFFFFFFE)
(len-test #x-FFFFFFFFE)
(len-test #x-FFFFFFFFFE)
(len-test #x-FFFFFFFFFFE)
(len-test #x-FFFFFFFFFFFE)
(len-test #x-FFFFFFFFFFFFE)
(len-test #x-FFFFFFFFFFFFFE)
(len-test #x-FFFFFFFFFFFFFFE)
(len-test #x-FFFFFFFFFFFFFFFE)
(len-test #x1)
(len-test #x1F)
(len-test #x1FF)
(len-test #x1FFF)
(len-test #x1FFFF)
(len-test #x1FFFFF)
(len-test #x1FFFFFF)
(len-test #x1FFFFFFF)
(len-test #x1FFFFFFFF)
(len-test #x1FFFFFFFFF)
(len-test #x1FFFFFFFFFF)
(len-test #x1FFFFFFFFFFF)
(len-test #x1FFFFFFFFFFFF)
(len-test #x1FFFFFFFFFFFFF)
(len-test #x1FFFFFFFFFFFFFF)
(len-test #x1FFFFFFFFFFFFFFF)
(len-test #x-1)
(len-test #x-1F)
(len-test #x-1FF)
(len-test #x-1FFF)
(len-test #x-1FFFF)
(len-test #x-1FFFFF)
(len-test #x-1FFFFFF)
(len-test #x-1FFFFFFF)
(len-test #x-1FFFFFFFF)
(len-test #x-1FFFFFFFFF)
(len-test #x-1FFFFFFFFFF)
(len-test #x-1FFFFFFFFFFF)
(len-test #x-1FFFFFFFFFFFF)
(len-test #x-1FFFFFFFFFFFFF)
(len-test #x-1FFFFFFFFFFFFFF)
(len-test #x-1FFFFFFFFFFFFFFF)
(len-test #x1)
(len-test #x10)
(len-test #x100)
(len-test #x1000)
(len-test #x10000)
(len-test #x100000)
(len-test #x1000000)
(len-test #x10000000)
(len-test #x100000000)
(len-test #x1000000000)
(len-test #x10000000000)
(len-test #x100000000000)
(len-test #x1000000000000)
(len-test #x10000000000000)
(len-test #x100000000000000)
(len-test #x1000000000000000)
(len-test #x-1)
(len-test #x-10)
(len-test #x-100)
(len-test #x-1000)
(len-test #x-10000)
(len-test #x-100000)
(len-test #x-1000000)
(len-test #x-10000000)
(len-test #x-100000000)
(len-test #x-1000000000)
(len-test #x-10000000000)
(len-test #x-100000000000)
(len-test #x-1000000000000)
(len-test #x-10000000000000)
(len-test #x-100000000000000)
(len-test #x-1000000000000000)
(len-test #x1)
(len-test #x11)
(len-test #x101)
(len-test #x1001)
(len-test #x10001)
(len-test #x100001)
(len-test #x1000001)
(len-test #x10000001)
(len-test #x100000001)
(len-test #x1000000001)
(len-test #x10000000001)
(len-test #x100000000001)
(len-test #x1000000000001)
(len-test #x10000000000001)
(len-test #x100000000000001)
(len-test #x1000000000000001)
(len-test #x-1)
(len-test #x-11)
(len-test #x-101)
(len-test #x-1001)
(len-test #x-10001)
(len-test #x-100001)
(len-test #x-1000001)
(len-test #x-10000001)
(len-test #x-100000001)
(len-test #x-1000000001)
(len-test #x-10000000001)
(len-test #x-100000000001)
(len-test #x-1000000000001)
(len-test #x-10000000000001)
(len-test #x-100000000000001)
(len-test #x-1000000000000001)
(len-test (greatest-fixnum))
(len-test (least-fixnum))
(count-test 1)
(count-test 28472347823493290482390849023840928390482309480923840923840983)
(count-test -847234234903290482390849023840928390482309480923840923840983)
(count-test (greatest-fixnum))
(count-test (least-fixnum))
(test (bitwise-not 12) -13)
(test (bitwise-not -12) 11)
(test (bitwise-not -1) 0)
(test (bitwise-not 0) -1)
(test (least-fixnum) (bitwise-not (greatest-fixnum)))
(test (greatest-fixnum) (bitwise-not (least-fixnum)))
(test (bitwise-not 38947389478348937489374)
-38947389478348937489375)
(test (bitwise-not #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
-22300745198530623141535718272648361505980416)
(test (bitwise-not -38947389478348937489375)
38947389478348937489374)
(test (bitwise-not #x-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
22300745198530623141535718272648361505980414)
(test (bitwise-not #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
-340282366920938463463374607431768211456)
(test (bitwise-not #x-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
340282366920938463463374607431768211454)
(test (bitwise-not #x1000000000000000000000000)
-79228162514264337593543950337)
(test (bitwise-not #x-1000000000000000000000000)
79228162514264337593543950335)
;; ----------------------------------------
(test (bitwise-and (expt 2 100) 17) 0)
(test (bitwise-and (- (expt 2 100) 1) 17) 17)
(test (bitwise-and (- (expt 2 100) 1) (expt 2 90)) (expt 2 90))
(test (bitwise-xor (expt 2 100) 17) (bitwise-ior (expt 2 100) 17))
(test (bitwise-xor (- (expt 2 100) 1) 17) (- (expt 2 100) 18))
(test (bitwise-xor (- (expt 2 100) 1) (expt 2 90)) (- (expt 2 100) (expt 2 90) 1))
(test (bitwise-if (expt 2 100) -1 1) (+ (expt 2 100) 1))
(test (bitwise-if (expt 2 100) 1 1) 1)
(test (bitwise-if (expt 2 100) (- (expt 2 200) 1) 1) (+ (expt 2 100) 1))
(test (bitwise-bit-count (expt 2 300)) 1)
(test (bitwise-bit-count (- (expt 2 300) 1)) 300)
(test (bitwise-bit-count (- (expt 2 300))) -301)
(test (bitwise-length (expt 2 300)) 301)
(test (bitwise-length (- (expt 2 300) 1)) 300)
(test (bitwise-length (- (expt 2 300))) 300)
(test (bitwise-first-bit-set (expt 2 300)) 300)
(test (bitwise-first-bit-set (- (expt 2 300) 1)) 0)
(test (bitwise-bit-set? (expt 2 300) 300) #t)
(test (bitwise-bit-set? (expt 2 300) 0) #f)
(test (bitwise-bit-set? (- (expt 2 300) 1) 300) #f)
(test (bitwise-bit-set? (- (expt 2 300) 1) 299) #t)
(test (bitwise-bit-set? (- (expt 2 300) 1) 298) #t)
(test (bitwise-bit-set? (- (expt 2 300) 2) 0) #f)
(test (bitwise-bit-set? -1 300) #t)
(test (bitwise-bit-set? -1 0) #t)
(test (bitwise-bit-set? -2 0) #f)
(test (bitwise-copy-bit-field (expt 2 300) 300 302 0) 0)
(test (bitwise-copy-bit-field (expt 2 300) 300 302 1) (expt 2 300))
(test (bitwise-copy-bit-field (expt 2 300) 300 302 2) (expt 2 301))
(test (bitwise-copy-bit-field (expt 2 300) 300 302 3) (+ (expt 2 300)
(expt 2 301)))
(test (bitwise-arithmetic-shift (expt 2 300) 1) (expt 2 301))
(test (bitwise-arithmetic-shift (expt 2 300) -1) (expt 2 299))
(test (bitwise-arithmetic-shift (expt 2 300) 300) (expt 2 600))
(test (bitwise-arithmetic-shift (expt 2 300) -300) 1)
(test (bitwise-arithmetic-shift-left (expt 2 300) 1) (expt 2 301))
(test (bitwise-arithmetic-shift-right (expt 2 300) 1) (expt 2 299))
(test (bitwise-arithmetic-shift-left (expt 2 300) 300) (expt 2 600))
(test (bitwise-arithmetic-shift-right (expt 2 300) 300) 1)
(test (bitwise-rotate-bit-field (expt 2 300) 299 304 2) (expt 2 302))
(test (bitwise-rotate-bit-field (expt 2 300) 299 304 4) (expt 2 299))
(test (bitwise-reverse-bit-field (expt 2 300) 299 304) (expt 2 302))
;;
))
Reference in New Issue View Git Blame Copy Permalink