From efe9dafabc2e2cc2dab079dfa3be3d09b3471c0f Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 15 Nov 2022 21:20:20 +0100
Subject: [PATCH] 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.
---
 gcc/fortran/arith.cc                   |  7 ++++++
 gcc/testsuite/gfortran.dg/pr107680.f90 | 34 ++++++++++++++++++++++++++
 2 files changed, 41 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107680.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index fc9224ebc5c..c4ab75b401c 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 00000000000..4ed431eb06f
--- /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" } }
--
2.35.3