mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix edge case in 'ash'.

Browse source 
* libguile/numbers.c (left_shift_exact_integer): Fix edge case where
  N is -1 and count is SCM_I_FIXNUM_BIT-1 to return the most negative
  fixnum.  Previously this result was returned as a bignum.

* test-suite/tests/numbers.test (ash): Add tests.
This commit is contained in:
Mark H Weaver 2013-10-03 14:25:51 -04:00
parent 1ea0803e9e
commit d360671c1c
2 changed files with 13 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

9
libguile/numbers.c
View file

@ -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,7 +4998,7 @@ 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))

8
test-suite/tests/numbers.test
View file

@ -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)