diff options
-rw-r--r-- | libguile/numbers.c | 13 | ||||
-rw-r--r-- | test-suite/tests/numbers.test | 24 |
2 files changed, 35 insertions, 2 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 21dcdb62c..a11ed3a8c 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -5053,6 +5053,11 @@ round_right_shift_exact_integer (SCM n, long count) assert (0); } +/* 'scm_ash' and 'scm_round_ash' assume that fixnums fit within a long, + and moreover that they can be negated without overflow. */ +verify (SCM_MOST_NEGATIVE_FIXNUM >= LONG_MIN + 1 + && SCM_MOST_POSITIVE_FIXNUM <= LONG_MAX); + SCM_DEFINE (scm_ash, "ash", 2, 0, 0, (SCM n, SCM count), "Return @math{floor(@var{n} * 2^@var{count})}.\n" @@ -5078,7 +5083,9 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0, if (SCM_I_INUMP (count)) /* fast path, not strictly needed */ bits_to_shift = SCM_I_INUM (count); - else if (scm_is_signed_integer (count, LONG_MIN, LONG_MAX)) + else if (scm_is_signed_integer (count, LONG_MIN + 1, LONG_MAX)) + /* We exclude LONG_MIN to ensure that 'bits_to_shift' can be + negated without overflowing. */ bits_to_shift = scm_to_long (count); else if (scm_is_false (scm_positive_p (scm_sum (scm_integer_length (n), count)))) @@ -5130,7 +5137,9 @@ SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0, if (SCM_I_INUMP (count)) /* fast path, not strictly needed */ bits_to_shift = SCM_I_INUM (count); - else if (scm_is_signed_integer (count, LONG_MIN, LONG_MAX)) + else if (scm_is_signed_integer (count, LONG_MIN + 1, LONG_MAX)) + /* We exclude LONG_MIN to ensure that 'bits_to_shift' can be + negated without overflowing. */ bits_to_shift = scm_to_long (count); else if (scm_is_true (scm_negative_p (scm_sum (scm_integer_length (n), count))) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 8cecb06ad..59e370ec9 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -5390,11 +5390,19 @@ (for-each (lambda (n) (for-each (lambda (count) (test n count)) `(-1000 + ,(* 2 (- fixnum-bit)) + ,(- -3 fixnum-bit) + ,(- -2 fixnum-bit) + ,(- -1 fixnum-bit) ,(- fixnum-bit) ,(- (- fixnum-bit 1)) -3 -2 -1 0 1 2 3 ,(- fixnum-bit 1) ,fixnum-bit + ,(+ fixnum-bit 1) + ,(+ fixnum-bit 2) + ,(+ fixnum-bit 3) + ,(* 2 fixnum-bit) 1000))) (list 0 1 3 23 -1 -3 -23 fixnum-max @@ -5423,6 +5431,22 @@ '(#b11001 #b11100 #b11101 #b10001 #b10100 #b10101))) (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min))) + ;; Right shift by LONG_MIN, typically (ash -1 63) and (ash -1 31) + ;; depending on the word size, where negating the shift count + ;; overflows. See <https://bugs.gnu.org/21901>. + (pass-if-equal "Right shift of positive integer by (ash -1 63) bits" + 0 + (ash-variant 123 (ash -1 63))) + (pass-if-equal "Right shift of negative integer by (ash -1 63) bits" + (if rounded? 0 -1) + (ash-variant -123 (ash -1 63))) + (pass-if-equal "Right shift of positive integer by (ash -1 31) bits" + 0 + (ash-variant 123 (ash -1 31))) + (pass-if-equal "Right shift of negative integer by (ash -1 31) bits" + (if rounded? 0 -1) + (ash-variant -123 (ash -1 31))) + ;; Huge shift counts (pass-if-equal "Huge left shift of 0" 0 |