fix bytevector-ieee-native-... tests (from Aziz) and checking in implementation

svn: r10893
This commit is contained in:
Matthew Flatt 2008-07-24 09:56:36 +00:00
parent 1f6007ce8b
commit 2c0b17cf19
2 changed files with 24 additions and 7 deletions

View File

@ -186,6 +186,13 @@
bytevector-s64-native-set!)
(make-integer-ops 8))
(define (check-offset size k)
(unless (and (exact-nonnegative-integer? k)
(zero? (bitwise-and (sub1 size) k)))
(raise-type-error 'bytevector-operation
(format "exact nonnegative integer multiple of ~a" size)
k)))
(define (make-ieee-ops size)
(values
;; -ref
@ -194,6 +201,7 @@
(floating-point-bytes->real bytes (eq? endianness 'big) k (+ k size)))
;; -native-ref
(lambda (bytes k)
(check-offset size k)
(floating-point-bytes->real bytes (system-big-endian?) k (+ k size)))
;; -set!
(lambda (bytes k n endianness)
@ -201,6 +209,7 @@
(real->floating-point-bytes n size (eq? endianness 'big) bytes k))
;; -native-set!
(lambda (bytes k n)
(check-offset size k)
(real->floating-point-bytes n size (system-big-endian?) bytes k)
(void))))

View File

@ -141,18 +141,26 @@
(lambda (k)
(for-each
(lambda (n)
(if (zero? (fxand k 3))
(let ([b (make-bytevector 12)])
(test/unspec (bytevector-ieee-single-native-set! b k n))
(test/approx (bytevector-ieee-single-native-ref b k) n))
(let ([b (make-bytevector 12)])
(test/exn (bytevector-ieee-single-native-set! b k n) &assertion)
(test/exn (bytevector-ieee-single-native-ref b k) &assertion)))
(let ([b (make-bytevector 12)])
(test/unspec (bytevector-ieee-single-set! b k n 'big))
(test/approx (bytevector-ieee-single-ref b k 'big) n))
(let ([b (make-bytevector 12)])
(test/unspec (bytevector-ieee-single-set! b k n 'little))
(test/approx (bytevector-ieee-single-ref b k 'little) n))
(if (zero? (fxand k 7))
(let ([b (make-bytevector 12)])
(test/unspec (bytevector-ieee-double-native-set! b k n))
(test/approx (bytevector-ieee-double-native-ref b k) n))
(let ([b (make-bytevector 12)])
(test/exn (bytevector-ieee-double-native-set! b k n) &assertion)
(test/exn (bytevector-ieee-double-native-ref b k) &assertion)))
(let ([b (make-bytevector 12)])
(test/unspec (bytevector-ieee-double-set! b k n 'big))
(test/approx (bytevector-ieee-double-ref b k 'big) n))