1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00

Avoid signed integer overflow in scm_product

* libguile/numbers.c (scm_product): Avoid signed integer overflow, which
  modern C compilers are allowed to assume will never happen, thus
  allowing them to optimize out our overflow checks.

* test-suite/tests/numbers.test (*): Add tests.
This commit is contained in:
Mark H Weaver 2012-12-07 11:53:00 -05:00
parent e6a730b22a
commit 2355f01709
2 changed files with 20 additions and 4 deletions

View file

@ -7640,10 +7640,16 @@ scm_product (SCM x, SCM y)
if (SCM_LIKELY (SCM_I_INUMP (y))) if (SCM_LIKELY (SCM_I_INUMP (y)))
{ {
scm_t_inum yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
scm_t_inum kk = xx * yy; #if SCM_I_FIXNUM_BIT < 32 && SCM_HAVE_T_INT64
SCM k = SCM_I_MAKINUM (kk); scm_t_int64 kk = xx * (scm_t_int64) yy;
if ((kk == SCM_I_INUM (k)) && (kk / xx == yy)) if (SCM_FIXABLE (kk))
return k; return SCM_I_MAKINUM (kk);
#else
scm_t_inum axx = (xx > 0) ? xx : -xx;
scm_t_inum ayy = (yy > 0) ? yy : -yy;
if (SCM_MOST_POSITIVE_FIXNUM / axx >= ayy)
return SCM_I_MAKINUM (xx * yy);
#endif
else else
{ {
SCM result = scm_i_inum2big (xx); SCM result = scm_i_inum2big (xx);

View file

@ -3070,6 +3070,16 @@
(pass-if (eqv? fixnum-min (* (* fixnum-min -1) -1))) (pass-if (eqv? fixnum-min (* (* fixnum-min -1) -1)))
(pass-if (equal? fixnum-min (* (* fixnum-min -1) -1)))) (pass-if (equal? fixnum-min (* (* fixnum-min -1) -1))))
(with-test-prefix "signed fixnum overflow"
(pass-if (eqv? (* 65536 65536) 4294967296))
(pass-if (eqv? (* -65536 65536) -4294967296))
(pass-if (eqv? (* 65536 -65536) -4294967296))
(pass-if (eqv? (* -65536 -65536) 4294967296))
(pass-if (eqv? (* 4294967296 4294967296) 18446744073709551616))
(pass-if (eqv? (* -4294967296 4294967296) -18446744073709551616))
(pass-if (eqv? (* 4294967296 -4294967296) -18446744073709551616))
(pass-if (eqv? (* -4294967296 -4294967296) 18446744073709551616)))
(with-test-prefix "signed zeroes" (with-test-prefix "signed zeroes"
(pass-if (eqv? +0.0 (* +0.0 +0.0))) (pass-if (eqv? +0.0 (* +0.0 +0.0)))
(pass-if (eqv? -0.0 (* -0.0 +0.0))) (pass-if (eqv? -0.0 (* -0.0 +0.0)))