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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@272320 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index def18108517d550757c2c7fa4fb3f1502467d605..ddb2353e44c93480ed96eea0cfb16e1afdec39d0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index f2d311c044c841f3f9d38551e17e7a43760df329..a4f879531d9d6e458af384c4cfc8917d6ca92af5 100644 (file)
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -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))
+               else
                  {
-                   /* 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);
+                   /* 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;
+                     }
                  }
-               else
-                 mpz_pow_ui (result->value.integer, op1->value.integer,
-                             power);
              }
              break;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7332d53d8e08479b885aeabe5484927f80a622f9..9fc92f38e6eaa85aaa712e7f99cd61e559334f8e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/integer_exponentiation_4.f90 b/gcc/testsuite/gfortran.dg/integer_exponentiation_4.f90
index 655f6514c57950bf2b74da32a2ca700b2b52c2e8..b224ef9671446d4213ca74098124dd3a647eb229 100644 (file)
--- a/gcc/testsuite/gfortran.dg/integer_exponentiation_4.f90
+++ b/gcc/testsuite/gfortran.dg/integer_exponentiation_4.f90
@@ -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)

diff --git a/gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90 b/gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90
index 6069bdf7d37b6ea5e827130c1dd7355ab2986fdb..f16b751b12815f57a1ffc8c6f355b01904e677da 100644 (file)
--- a/gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90
+++ b/gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90
@@ -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)

diff --git a/gcc/testsuite/gfortran.dg/no_range_check_1.f90 b/gcc/testsuite/gfortran.dg/no_range_check_1.f90
index d0bd242bbca508a7b27646349be5dd88a2759287..7066e19835ce89ee520a3a359785e1033239e07b 100644 (file)
--- a/gcc/testsuite/gfortran.dg/no_range_check_1.f90
+++ b/gcc/testsuite/gfortran.dg/no_range_check_1.f90
@@ -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