mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-21 18:11:44 +08:00
re PR fortran/31120 ([4.1/4.2 only] ICE with integer_exponentiation_1.f90 and -ffast-math)
PR fortran/31120 * trans-expr.c (gfc_conv_powi): Make n argument unsigned hwi. (gfc_conv_cst_int_power): Handle integer exponent with care, since it might be too large for us. * gfortran.dg/integer_exponentiation_2.f90: New test. From-SVN: r123028
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
a8af9c34fd
commit
6f85ab62b7
gcc
@ -1,3 +1,10 @@
|
|||||||
|
2007-03-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||||
|
|
||||||
|
PR fortran/31120
|
||||||
|
* trans-expr.c (gfc_conv_powi): Make n argument unsigned hwi.
|
||||||
|
(gfc_conv_cst_int_power): Handle integer exponent with care,
|
||||||
|
since it might be too large for us.
|
||||||
|
|
||||||
2007-03-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
2007-03-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||||
|
|
||||||
PR fortran/31184
|
PR fortran/31184
|
||||||
|
|||||||
@ -634,7 +634,7 @@ static const unsigned char powi_table[POWI_TABLE_SIZE] =
|
|||||||
/* Recursive function to expand the power operator. The temporary
|
/* Recursive function to expand the power operator. The temporary
|
||||||
values are put in tmpvar. The function returns tmpvar[1] ** n. */
|
values are put in tmpvar. The function returns tmpvar[1] ** n. */
|
||||||
static tree
|
static tree
|
||||||
gfc_conv_powi (gfc_se * se, int n, tree * tmpvar)
|
gfc_conv_powi (gfc_se * se, unsigned HOST_WIDE_INT n, tree * tmpvar)
|
||||||
{
|
{
|
||||||
tree op0;
|
tree op0;
|
||||||
tree op1;
|
tree op1;
|
||||||
@ -681,15 +681,25 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
|
|||||||
tree tmp;
|
tree tmp;
|
||||||
tree type;
|
tree type;
|
||||||
tree vartmp[POWI_TABLE_SIZE];
|
tree vartmp[POWI_TABLE_SIZE];
|
||||||
int n;
|
HOST_WIDE_INT m;
|
||||||
|
unsigned HOST_WIDE_INT n;
|
||||||
int sgn;
|
int sgn;
|
||||||
|
|
||||||
|
/* If exponent is too large, we won't expand it anyway, so don't bother
|
||||||
|
with large integer values. */
|
||||||
|
if (!double_int_fits_in_shwi_p (TREE_INT_CST (rhs)))
|
||||||
|
return 0;
|
||||||
|
|
||||||
|
m = double_int_to_shwi (TREE_INT_CST (rhs));
|
||||||
|
/* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care
|
||||||
|
of the asymmetric range of the integer type. */
|
||||||
|
n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m);
|
||||||
|
|
||||||
type = TREE_TYPE (lhs);
|
type = TREE_TYPE (lhs);
|
||||||
n = abs (TREE_INT_CST_LOW (rhs));
|
|
||||||
sgn = tree_int_cst_sgn (rhs);
|
sgn = tree_int_cst_sgn (rhs);
|
||||||
|
|
||||||
if (((FLOAT_TYPE_P (type) && !flag_unsafe_math_optimizations) || optimize_size)
|
if (((FLOAT_TYPE_P (type) && !flag_unsafe_math_optimizations)
|
||||||
&& (n > 2 || n < -1))
|
|| optimize_size) && (m > 2 || m < -1))
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
/* rhs == 0 */
|
/* rhs == 0 */
|
||||||
@ -698,6 +708,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
|
|||||||
se->expr = gfc_build_const (type, integer_one_node);
|
se->expr = gfc_build_const (type, integer_one_node);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */
|
/* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */
|
||||||
if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE))
|
if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE))
|
||||||
{
|
{
|
||||||
|
|||||||
@ -1,3 +1,8 @@
|
|||||||
|
2007-03-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||||
|
|
||||||
|
PR fortran/31120
|
||||||
|
* gfortran.dg/integer_exponentiation_2.f90: New test.
|
||||||
|
|
||||||
2007-03-17 Dorit Nuzman <dorit@il.ibm.com>
|
2007-03-17 Dorit Nuzman <dorit@il.ibm.com>
|
||||||
|
|
||||||
PR tree-optimization/31041
|
PR tree-optimization/31041
|
||||||
|
|||||||
253
gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90
Normal file
253
gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90
Normal file
@ -0,0 +1,253 @@
|
|||||||
|
! { dg-do run }
|
||||||
|
! { dg-options "" }
|
||||||
|
! Test various exponentations
|
||||||
|
! initially designed for patch to PR31120
|
||||||
|
|
||||||
|
program test
|
||||||
|
call run_me (1.0, 1, (1.0,0.0))
|
||||||
|
call run_me (-1.1, -1, (0.0,-1.0))
|
||||||
|
call run_me (42.0, 12, (1.0,7.0))
|
||||||
|
end program test
|
||||||
|
|
||||||
|
! This subroutine is for runtime tests
|
||||||
|
subroutine run_me(a, i, z)
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
real, intent(in) :: a
|
||||||
|
integer, intent(in) :: i
|
||||||
|
complex, intent(in) :: z
|
||||||
|
|
||||||
|
call check_equal_i (i**0, 1)
|
||||||
|
call check_equal_i (i**1, i)
|
||||||
|
call check_equal_i (i**2, i*i)
|
||||||
|
call check_equal_i (i**3, i*(i**2))
|
||||||
|
|
||||||
|
call check_equal_i (int(i**0_8,kind=4), 1)
|
||||||
|
call check_equal_i (int(i**1_8,kind=4), i)
|
||||||
|
call check_equal_i (int(i**2_8,kind=4), i*i)
|
||||||
|
call check_equal_i (int(i**3_8,kind=4), i*i*i)
|
||||||
|
|
||||||
|
call check_equal_r (a**0.0, 1.0)
|
||||||
|
call check_equal_r (a**1.0, a)
|
||||||
|
call check_equal_r (a**2.0, a*a)
|
||||||
|
call check_equal_r (a**3.0, a*(a**2))
|
||||||
|
call check_equal_r (a**-1.0, 1/a)
|
||||||
|
call check_equal_r (a**-2.0, (1/a)*(1/a))
|
||||||
|
|
||||||
|
call check_equal_r (a**0, 1.0)
|
||||||
|
call check_equal_r (a**1, a)
|
||||||
|
call check_equal_r (a**2, a*a)
|
||||||
|
call check_equal_r (a**3, a*(a**2))
|
||||||
|
call check_equal_r (a**-1, 1/a)
|
||||||
|
call check_equal_r (a**-2, (1/a)*(1/a))
|
||||||
|
|
||||||
|
call check_equal_r (a**0_8, 1.0)
|
||||||
|
call check_equal_r (a**1_8, a)
|
||||||
|
call check_equal_r (a**2_8, a*a)
|
||||||
|
call check_equal_r (a**3_8, a*(a**2))
|
||||||
|
call check_equal_r (a**-1_8, 1/a)
|
||||||
|
call check_equal_r (a**-2_8, (1/a)*(1/a))
|
||||||
|
|
||||||
|
call check_equal_c (z**0.0, (1.0,0.0))
|
||||||
|
call check_equal_c (z**1.0, z)
|
||||||
|
call check_equal_c (z**2.0, z*z)
|
||||||
|
call check_equal_c (z**3.0, z*(z**2))
|
||||||
|
call check_equal_c (z**-1.0, 1/z)
|
||||||
|
call check_equal_c (z**-2.0, (1/z)*(1/z))
|
||||||
|
|
||||||
|
call check_equal_c (z**(0.0,0.0), (1.0,0.0))
|
||||||
|
call check_equal_c (z**(1.0,0.0), z)
|
||||||
|
call check_equal_c (z**(2.0,0.0), z*z)
|
||||||
|
call check_equal_c (z**(3.0,0.0), z*(z**2))
|
||||||
|
call check_equal_c (z**(-1.0,0.0), 1/z)
|
||||||
|
call check_equal_c (z**(-2.0,0.0), (1/z)*(1/z))
|
||||||
|
|
||||||
|
call check_equal_c (z**0, (1.0,0.0))
|
||||||
|
call check_equal_c (z**1, z)
|
||||||
|
call check_equal_c (z**2, z*z)
|
||||||
|
call check_equal_c (z**3, z*(z**2))
|
||||||
|
call check_equal_c (z**-1, 1/z)
|
||||||
|
call check_equal_c (z**-2, (1/z)*(1/z))
|
||||||
|
|
||||||
|
call check_equal_c (z**0_8, (1.0,0.0))
|
||||||
|
call check_equal_c (z**1_8, z)
|
||||||
|
call check_equal_c (z**2_8, z*z)
|
||||||
|
call check_equal_c (z**3_8, z*(z**2))
|
||||||
|
call check_equal_c (z**-1_8, 1/z)
|
||||||
|
call check_equal_c (z**-2_8, (1/z)*(1/z))
|
||||||
|
|
||||||
|
|
||||||
|
contains
|
||||||
|
|
||||||
|
subroutine check_equal_r (a, b)
|
||||||
|
real, intent(in) :: a, b
|
||||||
|
if (abs(a - b) > 1.e-5 * abs(b)) call abort
|
||||||
|
end subroutine check_equal_r
|
||||||
|
|
||||||
|
subroutine check_equal_c (a, b)
|
||||||
|
complex, intent(in) :: a, b
|
||||||
|
if (abs(a - b) > 1.e-5 * abs(b)) call abort
|
||||||
|
end subroutine check_equal_c
|
||||||
|
|
||||||
|
subroutine check_equal_i (a, b)
|
||||||
|
integer, intent(in) :: a, b
|
||||||
|
if (a /= b) call abort
|
||||||
|
end subroutine check_equal_i
|
||||||
|
|
||||||
|
end subroutine run_me
|
||||||
|
|
||||||
|
! subroutine foo is used for compilation test only
|
||||||
|
subroutine foo(a)
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
real, intent(in) :: a
|
||||||
|
integer :: i
|
||||||
|
complex :: z
|
||||||
|
|
||||||
|
! Integer
|
||||||
|
call gee_i(i**0_1)
|
||||||
|
call gee_i(i**1_1)
|
||||||
|
call gee_i(i**2_1)
|
||||||
|
call gee_i(i**3_1)
|
||||||
|
call gee_i(i**-1_1)
|
||||||
|
call gee_i(i**-2_1)
|
||||||
|
call gee_i(i**-3_1)
|
||||||
|
call gee_i(i**huge(0_1))
|
||||||
|
call gee_i(i**-huge(0_1))
|
||||||
|
call gee_i(i**(-huge(0_1)-1_1))
|
||||||
|
|
||||||
|
call gee_i(i**0_2)
|
||||||
|
call gee_i(i**1_2)
|
||||||
|
call gee_i(i**2_2)
|
||||||
|
call gee_i(i**3_2)
|
||||||
|
call gee_i(i**-1_2)
|
||||||
|
call gee_i(i**-2_2)
|
||||||
|
call gee_i(i**-3_2)
|
||||||
|
call gee_i(i**huge(0_2))
|
||||||
|
call gee_i(i**-huge(0_2))
|
||||||
|
call gee_i(i**(-huge(0_2)-1_2))
|
||||||
|
|
||||||
|
call gee_i(i**0_4)
|
||||||
|
call gee_i(i**1_4)
|
||||||
|
call gee_i(i**2_4)
|
||||||
|
call gee_i(i**3_4)
|
||||||
|
call gee_i(i**-1_4)
|
||||||
|
call gee_i(i**-2_4)
|
||||||
|
call gee_i(i**-3_4)
|
||||||
|
call gee_i(i**huge(0_4))
|
||||||
|
call gee_i(i**-huge(0_4))
|
||||||
|
call gee_i(i**(-huge(0_4)-1_4))
|
||||||
|
|
||||||
|
call gee_i(i**0_8)
|
||||||
|
call gee_i(i**1_8)
|
||||||
|
call gee_i(i**2_8)
|
||||||
|
call gee_i(i**3_8)
|
||||||
|
call gee_i(i**-1_8)
|
||||||
|
call gee_i(i**-2_8)
|
||||||
|
call gee_i(i**-3_8)
|
||||||
|
call gee_i(i**huge(0_8))
|
||||||
|
call gee_i(i**-huge(0_8))
|
||||||
|
call gee_i(i**(-huge(0_8)-1_8))
|
||||||
|
|
||||||
|
! Real
|
||||||
|
call gee_r(a**0_1)
|
||||||
|
call gee_r(a**1_1)
|
||||||
|
call gee_r(a**2_1)
|
||||||
|
call gee_r(a**3_1)
|
||||||
|
call gee_r(a**-1_1)
|
||||||
|
call gee_r(a**-2_1)
|
||||||
|
call gee_r(a**-3_1)
|
||||||
|
call gee_r(a**huge(0_1))
|
||||||
|
call gee_r(a**-huge(0_1))
|
||||||
|
call gee_r(a**(-huge(0_1)-1_1))
|
||||||
|
|
||||||
|
call gee_r(a**0_2)
|
||||||
|
call gee_r(a**1_2)
|
||||||
|
call gee_r(a**2_2)
|
||||||
|
call gee_r(a**3_2)
|
||||||
|
call gee_r(a**-1_2)
|
||||||
|
call gee_r(a**-2_2)
|
||||||
|
call gee_r(a**-3_2)
|
||||||
|
call gee_r(a**huge(0_2))
|
||||||
|
call gee_r(a**-huge(0_2))
|
||||||
|
call gee_r(a**(-huge(0_2)-1_2))
|
||||||
|
|
||||||
|
call gee_r(a**0_4)
|
||||||
|
call gee_r(a**1_4)
|
||||||
|
call gee_r(a**2_4)
|
||||||
|
call gee_r(a**3_4)
|
||||||
|
call gee_r(a**-1_4)
|
||||||
|
call gee_r(a**-2_4)
|
||||||
|
call gee_r(a**-3_4)
|
||||||
|
call gee_r(a**huge(0_4))
|
||||||
|
call gee_r(a**-huge(0_4))
|
||||||
|
call gee_r(a**(-huge(0_4)-1_4))
|
||||||
|
|
||||||
|
call gee_r(a**0_8)
|
||||||
|
call gee_r(a**1_8)
|
||||||
|
call gee_r(a**2_8)
|
||||||
|
call gee_r(a**3_8)
|
||||||
|
call gee_r(a**-1_8)
|
||||||
|
call gee_r(a**-2_8)
|
||||||
|
call gee_r(a**-3_8)
|
||||||
|
call gee_r(a**huge(0_8))
|
||||||
|
call gee_r(a**-huge(0_8))
|
||||||
|
call gee_r(a**(-huge(0_8)-1_8))
|
||||||
|
|
||||||
|
! Complex
|
||||||
|
call gee_z(z**0_1)
|
||||||
|
call gee_z(z**1_1)
|
||||||
|
call gee_z(z**2_1)
|
||||||
|
call gee_z(z**3_1)
|
||||||
|
call gee_z(z**-1_1)
|
||||||
|
call gee_z(z**-2_1)
|
||||||
|
call gee_z(z**-3_1)
|
||||||
|
call gee_z(z**huge(0_1))
|
||||||
|
call gee_z(z**-huge(0_1))
|
||||||
|
call gee_z(z**(-huge(0_1)-1_1))
|
||||||
|
|
||||||
|
call gee_z(z**0_2)
|
||||||
|
call gee_z(z**1_2)
|
||||||
|
call gee_z(z**2_2)
|
||||||
|
call gee_z(z**3_2)
|
||||||
|
call gee_z(z**-1_2)
|
||||||
|
call gee_z(z**-2_2)
|
||||||
|
call gee_z(z**-3_2)
|
||||||
|
call gee_z(z**huge(0_2))
|
||||||
|
call gee_z(z**-huge(0_2))
|
||||||
|
call gee_z(z**(-huge(0_2)-1_2))
|
||||||
|
|
||||||
|
call gee_z(z**0_4)
|
||||||
|
call gee_z(z**1_4)
|
||||||
|
call gee_z(z**2_4)
|
||||||
|
call gee_z(z**3_4)
|
||||||
|
call gee_z(z**-1_4)
|
||||||
|
call gee_z(z**-2_4)
|
||||||
|
call gee_z(z**-3_4)
|
||||||
|
call gee_z(z**huge(0_4))
|
||||||
|
call gee_z(z**-huge(0_4))
|
||||||
|
call gee_z(z**(-huge(0_4)-1_4))
|
||||||
|
|
||||||
|
call gee_z(z**0_8)
|
||||||
|
call gee_z(z**1_8)
|
||||||
|
call gee_z(z**2_8)
|
||||||
|
call gee_z(z**3_8)
|
||||||
|
call gee_z(z**-1_8)
|
||||||
|
call gee_z(z**-2_8)
|
||||||
|
call gee_z(z**-3_8)
|
||||||
|
call gee_z(z**huge(0_8))
|
||||||
|
call gee_z(z**-huge(0_8))
|
||||||
|
call gee_z(z**(-huge(0_8)-1_8))
|
||||||
|
end subroutine foo
|
||||||
|
|
||||||
|
subroutine gee_i(i)
|
||||||
|
integer :: i
|
||||||
|
end subroutine gee_i
|
||||||
|
|
||||||
|
subroutine gee_r(r)
|
||||||
|
real :: r
|
||||||
|
end subroutine gee_r
|
||||||
|
|
||||||
|
subroutine gee_z(c)
|
||||||
|
complex :: c
|
||||||
|
end subroutine gee_z
|
||||||
Loading…
x
Reference in New Issue
Block a user