Le 07/10/2022 à 21:47, Mikael Morin a écrit :
Let me have a look.
The attached patch works with your test, I just moved the checks into
the loops.
I'm now checking the patch against the full fortran testsuite.
I'm (finally) fine with that version, what do you think of it?
From a2b393cab384a08164946916ff96dd576ebf7c97 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Tue, 4 Oct 2022 23:04:06 +0200
Subject: [PATCH] Fortran: error recovery for invalid types in array
constructors [PR107000]
gcc/fortran/ChangeLog:
PR fortran/107000
* arith.cc (gfc_arith_error): Define error message for
ARITH_INVALID_TYPE.
(reduce_unary): Catch arithmetic expressions with invalid type.
(reduce_binary_ac): Likewise.
(reduce_binary_ca): Likewise.
(reduce_binary_aa): Likewise.
(eval_intrinsic): Likewise.
(gfc_real2complex): Source expression must be of type REAL.
* gfortran.h (enum arith): Add ARITH_INVALID_TYPE.
gcc/testsuite/ChangeLog:
PR fortran/107000
* gfortran.dg/pr107000.f90: New test.
Co-authored-by: Mikael Morin <mik...@gcc.gnu.org>
---
gcc/fortran/arith.cc | 30 +++++++++++++---
gcc/fortran/gfortran.h | 2 +-
gcc/testsuite/gfortran.dg/pr107000.f90 | 50 ++++++++++++++++++++++++++
3 files changed, 76 insertions(+), 6 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr107000.f90
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index d57059a375f..086b1f856b1 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -118,6 +118,9 @@ gfc_arith_error (arith code)
case ARITH_WRONGCONCAT:
p = G_("Illegal type in character concatenation at %L");
break;
+ case ARITH_INVALID_TYPE:
+ p = G_("Invalid type in arithmetic operation at %L");
+ break;
default:
gfc_internal_error ("gfc_arith_error(): Bad error code");
@@ -1268,7 +1271,10 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op,
head = gfc_constructor_copy (op->value.constructor);
for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
{
- rc = reduce_unary (eval, c->expr, &r);
+ if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
+ rc = ARITH_INVALID_TYPE;
+ else
+ rc = reduce_unary (eval, c->expr, &r);
if (rc != ARITH_OK)
break;
@@ -1309,6 +1315,8 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
if (c->expr->expr_type == EXPR_CONSTANT)
rc = eval (c->expr, op2, &r);
+ else if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
+ rc = ARITH_INVALID_TYPE;
else
rc = reduce_binary_ac (eval, c->expr, op2, &r);
@@ -1361,6 +1369,8 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
if (c->expr->expr_type == EXPR_CONSTANT)
rc = eval (op1, c->expr, &r);
+ else if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
+ rc = ARITH_INVALID_TYPE;
else
rc = reduce_binary_ca (eval, op1, c->expr, &r);
@@ -1420,14 +1430,19 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
c && d;
c = gfc_constructor_next (c), d = gfc_constructor_next (d))
{
+ if ((c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
+ || (d->expr->expr_type == EXPR_OP && d->expr->ts.type == BT_UNKNOWN))
+ rc = ARITH_INVALID_TYPE;
+ else
rc = reduce_binary (eval, c->expr, d->expr, &r);
- if (rc != ARITH_OK)
- break;
- gfc_replace_expr (c->expr, r);
+ if (rc != ARITH_OK)
+ break;
+
+ gfc_replace_expr (c->expr, r);
}
- if (c || d)
+ if (rc == ARITH_OK && (c || d))
rc = ARITH_INCOMMENSURATE;
if (rc != ARITH_OK)
@@ -1638,6 +1653,8 @@ eval_intrinsic (gfc_intrinsic_op op,
else
rc = reduce_binary (eval.f3, op1, op2, &result);
+ if (rc == ARITH_INVALID_TYPE)
+ goto runtime;
/* Something went wrong. */
if (op == INTRINSIC_POWER && rc == ARITH_PROHIBIT)
@@ -2238,6 +2255,9 @@ gfc_real2complex (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
+ if (src->ts.type != BT_REAL)
+ return NULL;
+
result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
mpc_set_fr (result->value.complex, src->value.real, GFC_MPC_RND_MODE);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4babd77924b..fc0aa51df57 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -226,7 +226,7 @@ enum gfc_intrinsic_op
enum arith
{ ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT,
- ARITH_WRONGCONCAT
+ ARITH_WRONGCONCAT, ARITH_INVALID_TYPE
};
/* Statements. */
diff --git a/gcc/testsuite/gfortran.dg/pr107000.f90 b/gcc/testsuite/gfortran.dg/pr107000.f90
new file mode 100644
index 00000000000..30289078c57
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107000.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! PR fortran/107000 - ICE in gfc_real2complex, reduce_unary, reduce_binary_*
+! Contributed by G.Steinmetz
+
+program p
+ real :: y(1)
+ complex :: x(1)
+ x = (1.0, 2.0) * [real :: -'1'] ! { dg-error "Operand of unary numeric operator" }
+ x = (1.0, 2.0) * [complex :: +'1'] ! { dg-error "Operand of unary numeric operator" }
+ x = [complex :: -'1'] * (1.0, 2.0) ! { dg-error "Operand of unary numeric operator" }
+ y = [complex :: -'1'] * 2 ! { dg-error "Operand of unary numeric operator" }
+ y = 2 * [complex :: -'1'] ! { dg-error "Operand of unary numeric operator" }
+ y = 2 * [complex :: -(.true.)] ! { dg-error "Operand of unary numeric operator" }
+ y = [complex :: -(.true.)] * 2 ! { dg-error "Operand of unary numeric operator" }
+ print *, - [real :: -'1' ] ! { dg-error "Operand of unary numeric operator" }
+ print *, - [real :: [-'1']] ! { dg-error "Operand of unary numeric operator" }
+ print *, - [real :: +(.true.) ] ! { dg-error "Operand of unary numeric operator" }
+ print *, - [real :: [+(.true.)]] ! { dg-error "Operand of unary numeric operator" }
+ print *, 2 * [real :: -'1' ] ! { dg-error "Operand of unary numeric operator" }
+ print *, 2 * [real :: (-'1')] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: -'1' ] * 2 ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: (-'1')] * 2 ! { dg-error "Operand of unary numeric operator" }
+ print *, 2 * [integer :: -('1')] ! { dg-error "Operand of unary numeric operator" }
+ print *, [integer :: -('1')] * 2 ! { dg-error "Operand of unary numeric operator" }
+ print *, 2 * [real :: 0, (-'1')] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 0, (-'1')] * 2 ! { dg-error "Operand of unary numeric operator" }
+ print *, 2 * [real :: 0, -'1'] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 0, -'1'] * 2 ! { dg-error "Operand of unary numeric operator" }
+ print *, 2 * [real :: 0, 1+'1'] ! { dg-error "Operands of binary numeric operator" }
+ print *, [real :: 0, 1+'1'] * 2 ! { dg-error "Operands of binary numeric operator" }
+ print *, [real :: 1, +(.true.)] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 1, -(.true.)] ! { dg-error "Operand of unary numeric operator" }
+ print *, 2 * [real :: 1, +(.true.)] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 1, +(.true.)] * 2 ! { dg-error "Operand of unary numeric operator" }
+ print *, [1, 2] * [real :: 1, +(.true.)] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 1, +(.true.)] * [1, 2] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 1, 2] * [real :: 1, +(.true.)] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 1, +(.true.)] * [real :: 1, 2] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 0, -'1'] * [real :: 1, +(+(.true.))] ! { dg-error "Operand of unary numeric operator" }
+ print *, [real :: 1, [(+(.true.))]] * [real :: 0, [(-'1')]] ! { dg-error "Operand of unary numeric operator" }
+
+ ! Legal:
+ print *, 2 * [real :: 1, [2], 3]
+ print *, [real :: 1, [2], 3] * 2
+ print *, [real :: 1, [2], 3] * [real :: 1, [2], 3]
+ print *, [real :: 1, [2], 3] * [integer :: 1, [2], 3]
+ print *, [real :: 1, [2], 3] * [1, [2], 3]
+ print *, [real :: 1, huge(2.0)] * [real :: 1, real(1.0)]
+ print *, [real :: 1, -(huge(2.0))] * [real :: 1, +(real(1))]
+end
--
2.35.1
