diff options
author | Andy Wingo <wingo@pobox.com> | 2016-06-21 09:32:30 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-06-21 09:32:30 +0200 |
commit | beea6302e06e7e41b1b835b2327febc97177010e (patch) | |
tree | c6827adc5e0606f3c22f5209ce0822b4c320af5b /module/rnrs | |
parent | 845c873acf8cb57766dfbd565640a84d5d05ddb0 (diff) | |
download | guile-beea6302e06e7e41b1b835b2327febc97177010e.tar.gz |
Fix fixnum-range changes in R6RS fixnum bitops
* module/rnrs/arithmetic/fixnums.scm (fxcopy-bit, fxbit-field)
(fxcopy-bit-field, fxarithmetic-shift)
(fxarithmetic-shift-left, fx-arithmetic-shift-right)
(fxrotate-bit-field, fxreverse-bit-field): Enforce range on amount by
which to shift. Fixes #14917.
* test-suite/tests/r6rs-arithmetic-fixnums.test ("fxarithmetic-shift-left"):
Update test to not shift left by a negative amount.
Diffstat (limited to 'module/rnrs')
-rw-r--r-- | module/rnrs/arithmetic/fixnums.scm | 28 |
1 files changed, 25 insertions, 3 deletions
diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm index 7a5a6215e..4ec1cae0c 100644 --- a/module/rnrs/arithmetic/fixnums.scm +++ b/module/rnrs/arithmetic/fixnums.scm @@ -242,28 +242,50 @@ (define (fxcopy-bit fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) + (unless (and (<= 0 fx2) (< fx2 (fixnum-width))) + (raise (make-assertion-violation))) (bitwise-copy-bit fx1 fx2 fx3)) (define (fxbit-field fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) + (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width))) + (raise (make-assertion-violation))) (bitwise-bit-field fx1 fx2 fx3)) (define (fxcopy-bit-field fx1 fx2 fx3 fx4) (assert-fixnum fx1 fx2 fx3 fx4) + (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width))) + (raise (make-assertion-violation))) (bitwise-copy-bit-field fx1 fx2 fx3 fx4)) - (define (fxarithmetic-shift fx1 fx2) (assert-fixnum fx1 fx2) (ash fx1 fx2)) - (define fxarithmetic-shift-left fxarithmetic-shift) + (define (fxarithmetic-shift fx1 fx2) + (assert-fixnum fx1 fx2) + (unless (< (abs fx2) (fixnum-width)) + (raise (make-assertion-violation))) + (ash fx1 fx2)) + + (define (fxarithmetic-shift-left fx1 fx2) + (assert-fixnum fx1 fx2) + (unless (and (<= 0 fx2) (< fx2 (fixnum-width))) + (raise (make-assertion-violation))) + (ash fx1 fx2)) (define (fxarithmetic-shift-right fx1 fx2) - (assert-fixnum fx1 fx2) (ash fx1 (- fx2))) + (assert-fixnum fx1 fx2) + (unless (and (<= 0 fx2) (< fx2 (fixnum-width))) + (raise (make-assertion-violation))) + (ash fx1 (- fx2))) (define (fxrotate-bit-field fx1 fx2 fx3 fx4) (assert-fixnum fx1 fx2 fx3 fx4) + (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width)) (< fx4 (- fx3 fx2))) + (raise (make-assertion-violation))) (bitwise-rotate-bit-field fx1 fx2 fx3 fx4)) (define (fxreverse-bit-field fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) + (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width))) + (raise (make-assertion-violation))) (bitwise-reverse-bit-field fx1 fx2 fx3)) ) |