diff options
| author | Mark H Weaver <mhw@netris.org> | 2013-10-03 14:25:51 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2013-10-03 14:25:51 -0400 |
| commit | 8df68898b9f6ba15171244f1f3549688f13d605f (patch) | |
| tree | dc8d7ae7e5593c504aaa83339468048c0432b243 | |
| parent | 84af582d1e9b5f04270d263a89aaa844750177d3 (diff) | |
| download | guile-8df68898b9f6ba15171244f1f3549688f13d605f.tar.gz | |
Fix edge case in 'ash'.
* libguile/numbers.c (scm_ash): Fix (ash -1 SCM_I_FIXNUM_BIT-1) to
return a fixnum instead of a bignum.
* test-suite/tests/numbers.test (ash): Add tests.
| -rw-r--r-- | libguile/numbers.c | 11 | ||||
| -rw-r--r-- | test-suite/tests/numbers.test | 8 |
2 files changed, 14 insertions, 5 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 6f3a6ec46..38c28a4b7 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -4978,11 +4978,14 @@ left_shift_exact_integer (SCM n, long count) { scm_t_inum nn = SCM_I_INUM (n); - /* Left shift of count >= SCM_I_FIXNUM_BIT-1 will always + /* Left shift of count >= SCM_I_FIXNUM_BIT-1 will almost[*] always overflow a non-zero fixnum. For smaller shifts we check the bits going into positions above SCM_I_FIXNUM_BIT-1. If they're all 0s for nn>=0, or all 1s for nn<0 then there's no overflow. - Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 - count)". */ + Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 - count)". + + [*] There's one exception: + (-1) << SCM_I_FIXNUM_BIT-1 == SCM_MOST_NEGATIVE_FIXNUM */ if (nn == 0) return n; @@ -4995,8 +4998,8 @@ left_shift_exact_integer (SCM n, long count) SCM result = scm_i_inum2big (nn); mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), count); - return result; - } + return scm_i_normbig (result); + } } else if (SCM_BIGP (n)) { diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 68f8f91a7..16f06bf83 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -5360,7 +5360,13 @@ (for-each (lambda (n) (for-each (lambda (count) (test n count)) - '(-1000 -3 -2 -1 0 1 2 3 1000))) + `(-1000 + ,(- fixnum-bit) + ,(- (- fixnum-bit 1)) + -3 -2 -1 0 1 2 3 + ,(- fixnum-bit 1) + ,fixnum-bit + 1000))) (list 0 1 3 23 -1 -3 -23 fixnum-max (1+ fixnum-max) |