From: Francois-Xavier Coudert Date: Sat, 17 Mar 2007 19:58:37 +0000 (+0100) Subject: re PR fortran/31120 ([4.1/4.2 only] ICE with integer_exponentiation_1.f90 and -ffast... X-Git-Tag: releases/gcc-4.3.0~6176 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=6f85ab62b70089d6568902e6d74c37e8bbcc8e43;p=thirdparty%2Fgcc.git 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b54953f16895..76305392a7e4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-03-17 Francois-Xavier Coudert + + 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 PR fortran/31184 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b6c132bc160c..c6448ec73833 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -634,7 +634,7 @@ static const unsigned char powi_table[POWI_TABLE_SIZE] = /* Recursive function to expand the power operator. The temporary values are put in tmpvar. The function returns tmpvar[1] ** n. */ 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 op1; @@ -681,15 +681,25 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) tree tmp; tree type; tree vartmp[POWI_TABLE_SIZE]; - int n; + HOST_WIDE_INT m; + unsigned HOST_WIDE_INT n; 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); - n = abs (TREE_INT_CST_LOW (rhs)); sgn = tree_int_cst_sgn (rhs); - if (((FLOAT_TYPE_P (type) && !flag_unsafe_math_optimizations) || optimize_size) - && (n > 2 || n < -1)) + if (((FLOAT_TYPE_P (type) && !flag_unsafe_math_optimizations) + || optimize_size) && (m > 2 || m < -1)) return 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); return 1; } + /* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */ if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE)) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 478aa77606dd..51282fab131d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-03-17 Francois-Xavier Coudert + + PR fortran/31120 + * gfortran.dg/integer_exponentiation_2.f90: New test. + 2007-03-17 Dorit Nuzman PR tree-optimization/31041 diff --git a/gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90 b/gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90 new file mode 100644 index 000000000000..4701cea79271 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90 @@ -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