aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2022-11-15 21:20:20 +0100
committerHarald Anlauf <anlauf@gmx.de>2022-11-16 21:13:16 +0100
commit713dcfc85ebbabaf74a1bcbac4ba1143519b31d6 (patch)
treeb2920853c359e4720fe0b9c3c14f1ef6203c2c99
parentac74b3f82b339569b34dc9d1330c2faf74a1c82a (diff)
downloadgcc-713dcfc85ebbabaf74a1bcbac4ba1143519b31d6.zip
gcc-713dcfc85ebbabaf74a1bcbac4ba1143519b31d6.tar.gz
gcc-713dcfc85ebbabaf74a1bcbac4ba1143519b31d6.tar.bz2
Fortran: ICE in simplification of array expression involving power [PR107680]
gcc/fortran/ChangeLog: PR fortran/107680 * arith.cc (arith_power): Check that operands are properly converted before attempting to simplify. gcc/testsuite/ChangeLog: PR fortran/107680 * gfortran.dg/pr107680.f90: New test.
-rw-r--r--gcc/fortran/arith.cc7
-rw-r--r--gcc/testsuite/gfortran.dg/pr107680.f9034
2 files changed, 41 insertions, 0 deletions
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index fc9224eb..c4ab75b 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -845,6 +845,13 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
if (!gfc_numeric_ts (&op1->ts) || !gfc_numeric_ts (&op2->ts))
return ARITH_INVALID_TYPE;
+ /* The result type is derived from op1 and must be compatible with the
+ result of the simplification. Otherwise postpone simplification until
+ after operand conversions usually done by gfc_type_convert_binary. */
+ if ((op1->ts.type == BT_INTEGER && op2->ts.type != BT_INTEGER)
+ || (op1->ts.type == BT_REAL && op2->ts.type == BT_COMPLEX))
+ return ARITH_NOT_REDUCED;
+
rc = ARITH_OK;
result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
diff --git a/gcc/testsuite/gfortran.dg/pr107680.f90 b/gcc/testsuite/gfortran.dg/pr107680.f90
new file mode 100644
index 0000000..4ed431e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107680.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/107680 - ICE in arith_power
+! Contributed by G.Steinmetz
+
+program p
+ real, parameter :: x(*) = [real :: ([1])] ** 2.0
+ complex, parameter :: y(*) = [real :: ([1])] ** (2.0,1.0)
+ complex, parameter :: z(*) = [complex :: ([1])] ** (2.0,1.0)
+ complex, parameter :: u(*) = [complex :: ([1.0])] ** (2.0,1.0)
+ complex, parameter :: v(*) = [real :: ([(1.0,2.0)])] ** (3.0,1.0)
+ complex, parameter :: w(*) = [integer :: ([(1.0,2.0)])] ** (3.0,1.0)
+ print *, [real :: ([3])] ** 2
+ print *, [real :: ([3])] ** 2.0
+ print *, [real :: ([1])] ** (1.0,2.0)
+ print *, [real :: ([1.0])] ** (1.0,2.0)
+ print *, [complex :: ([3])] ** 2
+ print *, [complex :: ([3])] ** 2.0
+ print *, [complex :: ([1])] ** (1.0,2.0)
+ print *, [complex :: ([1.0])] ** (1.0,2.0)
+ print *, [integer :: ([3.0])] ** 2
+ print *, [integer :: ([3.0])] ** 2.0
+ print *, [integer :: ([1.0])] ** (1.0,2.0)
+ print *, [integer :: ([(1.0,2.0)])] ** (3.0,1.0)
+ print *, v(1)
+ if (u(1) /= 1) stop 1
+ if (v(1) /= 1) stop 2
+ if (w(1) /= 1) stop 3
+ if (x(1) /= 1) stop 4
+ if (y(1) /= 1) stop 5
+ if (z(1) /= 1) stop 6
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }