fix bytevector-ieee-native-... tests (from Aziz) and checking in implementation
svn: r10893
This commit is contained in:
parent
1f6007ce8b
commit
2c0b17cf19
|
@ -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))))
|
||||
|
||||
|
|
|
@ -136,23 +136,31 @@
|
|||
(test (bytevector-s64-ref b 8 (endianness little)) -144115188075855873)
|
||||
(test (bytevector-u64-ref b 8 (endianness big)) 18446744073709551613)
|
||||
(test (bytevector-s64-ref b 8 (endianness big)) -3))
|
||||
|
||||
|
||||
(for-each
|
||||
(lambda (k)
|
||||
(for-each
|
||||
(lambda (n)
|
||||
(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))
|
||||
(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))
|
||||
(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))
|
||||
(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))
|
||||
|
|
Loading…
Reference in New Issue
Block a user