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 bugs when negating SCM_MOST_POSITIVE_FIXNUM+1

Browse source 
* libguile/numbers.c (scm_difference, scm_product):
  Fix bugs when negating SCM_MOST_POSITIVE_FIXNUM+1,
  aka -SCM_MOST_NEGATIVE_FIXNUM.  Previously, these cases
  failed to normalize the result to a fixnum, causing
  `=', `eqv?' and `equal?' to fail, e.g.:
  (= most-negative-fixnum (- 0 (- most-negative-fixnum)))
  (= most-negative-fixnum (* -1 (- most-negative-fixnum)))
  (= most-negative-fixnum (* (- most-negative-fixnum) -1))

* test-suite/test/numbers.test: Add test cases to detect
  bugs when negating SCM_MOST_POSITIVE_FIXNUM+1 and
  SCM_MOST_NEGATIVE_FIXNUM by various methods.
This commit is contained in:
Mark H Weaver 2011-01-26 05:21:03 -05:00 • committed by Andy Wingo
parent 425d55f969
commit b5c40589ec
2 changed files with 43 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

17
libguile/numbers.c
View file

@ -4488,7 +4488,11 @@ scm_difference (SCM x, SCM y)
scm_t_inum xx = SCM_I_INUM (x);
if (xx == 0)
return scm_i_clonebig (y, 0);
{
/* Must scm_i_normbig here because -SCM_MOST_NEGATIVE_FIXNUM is a
bignum, but negating that gives a fixnum. */
return scm_i_normbig (scm_i_clonebig (y, 0));
}
else
{
int sgn_y = mpz_sgn (SCM_I_BIG_MPZ (y));
@ -4720,6 +4724,17 @@ scm_product (SCM x, SCM y)
{
case 0: return x; break;
case 1: return y; break;
/*
* The following case (x = -1) is important for more than
* just optimization. It handles the case of negating
* (+ 1 most-positive-fixnum) aka (- most-negative-fixnum),
* which is a bignum that must be changed back into a fixnum.
* Failure to do so will cause the following to return #f:
* (= most-negative-fixnum (* -1 (- most-negative-fixnum)))
*/
case -1:
return scm_difference(y, SCM_UNDEFINED);
break;
}
if (SCM_LIKELY (SCM_I_INUMP (y)))

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

@ -2525,6 +2525,20 @@
(with-test-prefix/c&e "-"
(pass-if "double-negation of fixnum-min: ="
(= fixnum-min (- (- fixnum-min))))
(pass-if "double-negation of fixnum-min: eqv?"
(eqv? fixnum-min (- (- fixnum-min))))
(pass-if "double-negation of fixnum-min: equal?"
(equal? fixnum-min (- (- fixnum-min))))
(pass-if "binary double-negation of fixnum-min: ="
(= fixnum-min (- 0 (- 0 fixnum-min))))
(pass-if "binary double-negation of fixnum-min: eqv?"
(eqv? fixnum-min (- 0 (- 0 fixnum-min))))
(pass-if "binary double-negation of fixnum-min: equal?"
(equal? fixnum-min (- 0 (- 0 fixnum-min))))
(pass-if "-inum - +bignum"
(= #x-100000000000000000000000000000001
(- -1 #x100000000000000000000000000000000)))
@ -2554,6 +2568,14 @@
(with-test-prefix "*"
(with-test-prefix "double-negation of fixnum-min"
(pass-if (= fixnum-min (* -1 (* -1 fixnum-min))))
(pass-if (eqv? fixnum-min (* -1 (* -1 fixnum-min))))
(pass-if (equal? fixnum-min (* -1 (* -1 fixnum-min))))
(pass-if (= fixnum-min (* (* fixnum-min -1) -1)))
(pass-if (eqv? fixnum-min (* (* fixnum-min -1) -1)))
(pass-if (equal? fixnum-min (* (* fixnum-min -1) -1))))
(with-test-prefix "inum * bignum"
(pass-if "0 * 2^256 = 0"
@ -2607,6 +2629,11 @@
(with-test-prefix "/"
(with-test-prefix "double-negation of fixnum-min"
(pass-if (= 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 "documented?"
(documented? /))