From a2b393cab384a08164946916ff96dd576ebf7c97 Mon Sep 17 00:00:00 2001 From: Harald Anlauf 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 --- 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