procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

arith.c (arith_power): Rework overflow of an integer to an integer exponent.

Browse source 
2019-06-14  Steven G. Kargl  <kargl@gcc.gnu.org>

	* arith.c (arith_power): Rework overflow of an integer to an integer
	exponent.

2019-06-14  Steven G. Kargl  <kargl@gcc.gnu.org>

	* gfortran.dg/integer_exponentiation_4.f90: Update test.
	* gfortran.dg/integer_exponentiation_5.F90: Ditto.
	* gfortran.dg/no_range_check_1.f90: Ditto.

From-SVN: r272320
This commit is contained in:
Steven G. Kargl 2019-06-15 00:38:55 +00:00
parent 4e20bd42bc
commit 2789efe3ee
6 changed files with 44 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View file

@ -1,3 +1,8 @@
2019-06-14 Steven G. Kargl <kargl@gcc.gnu.org>
* arith.c (arith_power): Rework overflow of an integer to an integer
exponent.
2019-06-14 Harald Anlauf <anlauf@gmx.de>
PR fortran/90577

53
gcc/fortran/arith.c
View file

@ -848,8 +848,6 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
{
case BT_INTEGER:
{
int power;
/* First, we simplify the cases of op1 == 1, 0 or -1. */
if (mpz_cmp_si (op1->value.integer, 1) == 0)
{
@ -884,29 +882,36 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
"exponent of integer has zero "
"result at %L", &result->where);
}
else if (gfc_extract_int (op2, &power))
{
/* If op2 doesn't fit in an int, the exponentiation will
overflow, because op2 > 0 and abs(op1) > 1. */
mpz_t max;
int i;
i = gfc_validate_kind (BT_INTEGER, result->ts.kind, false);
if (flag_range_check)
rc = ARITH_OVERFLOW;
/* Still, we want to give the same value as the
processor. */
mpz_init (max);
mpz_add_ui (max, gfc_integer_kinds[i].huge, 1);
mpz_mul_ui (max, max, 2);
mpz_powm (result->value.integer, op1->value.integer,
op2->value.integer, max);
mpz_clear (max);
}
else
mpz_pow_ui (result->value.integer, op1->value.integer,
power);
{
/* We have abs(op1) > 1 and op2 > 1.
If op2 > bit_size(op1), we'll have an out-of-range
result. */
int k, power;
k = gfc_validate_kind (BT_INTEGER, op1->ts.kind, false);
power = gfc_integer_kinds[k].bit_size;
if (mpz_cmp_si (op2->value.integer, power) < 0)
{
gfc_extract_int (op2, &power);
mpz_pow_ui (result->value.integer, op1->value.integer,
power);
rc = gfc_range_check (result);
if (rc == ARITH_OVERFLOW)
gfc_error_now ("Result of exponentiation at %L "
"exceeds the range of %s", &op1->where,
gfc_typename (&(op1->ts)));
}
else
{
/* Provide a nonsense value to propagate up. */
mpz_set (result->value.integer,
gfc_integer_kinds[k].huge);
mpz_add_ui (result->value.integer,
result->value.integer, 1);
rc = ARITH_OVERFLOW;
}
}
}
break;

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2019-06-14 Steven G. Kargl <kargl@gcc.gnu.org>
* gfortran.dg/integer_exponentiation_4.f90: Update test.
* gfortran.dg/integer_exponentiation_5.F90: Ditto.
* gfortran.dg/no_range_check_1.f90: Ditto.
2019-06-14 Harald Anlauf <anlauf@gmx.de>
PR fortran/90577

8
gcc/testsuite/gfortran.dg/integer_exponentiation_4.f90
View file

@ -21,10 +21,10 @@ program test
print *, (-1)**huge(0_8)
print *, (-1)**(-huge(0_8)-1_8)
print *, 2**huge(0) ! { dg-error "Arithmetic overflow" }
print *, 2**huge(0_8) ! { dg-error "Arithmetic overflow" }
print *, (-2)**huge(0) ! { dg-error "Arithmetic overflow" }
print *, (-2)**huge(0_8) ! { dg-error "Arithmetic overflow" }
print *, 2**huge(0) ! { dg-error "Arithmetic overflow|exceeds the range" }
print *, 2**huge(0_8) ! { dg-error "Arithmetic overflow|exceeds the range" }
print *, (-2)**huge(0) ! { dg-error "Arithmetic overflow|exceeds the range" }
print *, (-2)**huge(0_8) ! { dg-error "Arithmetic overflow|exceeds the range" }
print *, 2**(-huge(0)-1)
print *, 2**(-huge(0_8)-1_8)

2
gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90
View file

@ -67,8 +67,6 @@ program test
TEST(3_8,43_8,i8)
TEST(-3_8,43_8,i8)
TEST(17_8,int(huge(0_4),kind=8)+1,i8)
!!!!! REAL BASE !!!!!
TEST(0.0,-1,r4)
TEST(0.0,-huge(0)-1,r4)

3
gcc/testsuite/gfortran.dg/no_range_check_1.f90
View file

@ -4,11 +4,8 @@
! This testcase arose from PR 31262
integer :: a
integer(kind=8) :: b
a = -3
b = -huge(b) / 7
a = a ** 73
b = 7894_8 * b - 78941_8
if ((-3)**73 /= a) STOP 1
if (7894_8 * (-huge(b) / 7) - 78941_8 /= b) STOP 2
a = 1234789786453123