suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/rnrs/bytevectors-6.ss
View File

@ -186,6 +186,13 @@
bytevector-s64-native-set!) bytevector-s64-native-set!)
(make-integer-ops 8)) (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) (define (make-ieee-ops size)
(values (values
;; -ref ;; -ref
@ -194,6 +201,7 @@
(floating-point-bytes->real bytes (eq? endianness 'big) k (+ k size))) (floating-point-bytes->real bytes (eq? endianness 'big) k (+ k size)))
;; -native-ref ;; -native-ref
(lambda (bytes k) (lambda (bytes k)
(check-offset size k)
(floating-point-bytes->real bytes (system-big-endian?) k (+ k size))) (floating-point-bytes->real bytes (system-big-endian?) k (+ k size)))
;; -set! ;; -set!
(lambda (bytes k n endianness) (lambda (bytes k n endianness)
@ -201,6 +209,7 @@
(real->floating-point-bytes n size (eq? endianness 'big) bytes k)) (real->floating-point-bytes n size (eq? endianness 'big) bytes k))
;; -native-set! ;; -native-set!
(lambda (bytes k n) (lambda (bytes k n)
(check-offset size k)
(real->floating-point-bytes n size (system-big-endian?) bytes k) (real->floating-point-bytes n size (system-big-endian?) bytes k)
(void)))) (void))))

20
collects/tests/r6rs/bytevectors.sls
View File

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