From ad892a270c504def2f8f84494d5c7bcba9aef27f 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. (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. --- gcc/fortran/arith.cc | 19 ++++++++++ gcc/fortran/gfortran.h | 2 +- gcc/testsuite/gfortran.dg/pr107000.f90 | 50 ++++++++++++++++++++++++++ 3 files changed, 70 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/pr107000.f90 diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc index d57059a375f..e6e35ef3c42 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"); @@ -1261,6 +1264,9 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op, gfc_expr *r; arith rc; + if (op->expr_type == EXPR_OP && op->ts.type == BT_UNKNOWN) + return ARITH_INVALID_TYPE; + if (op->expr_type == EXPR_CONSTANT) return eval (op, result); @@ -1302,6 +1308,9 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), gfc_expr *r; arith rc = ARITH_OK; + if (op1->expr_type == EXPR_OP && op1->ts.type == BT_UNKNOWN) + return ARITH_INVALID_TYPE; + head = gfc_constructor_copy (op1->value.constructor); for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c)) { @@ -1354,6 +1363,9 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), gfc_expr *r; arith rc = ARITH_OK; + if (op2->expr_type == EXPR_OP && op2->ts.type == BT_UNKNOWN) + return ARITH_INVALID_TYPE; + head = gfc_constructor_copy (op2->value.constructor); for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c)) { @@ -1414,6 +1426,10 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), if (!gfc_check_conformance (op1, op2, _("elemental binary operation"))) return ARITH_INCOMMENSURATE; + if ((op1->expr_type == EXPR_OP && op1->ts.type == BT_UNKNOWN) + || (op2->expr_type == EXPR_OP && op2->ts.type == BT_UNKNOWN)) + return ARITH_INVALID_TYPE; + head = gfc_constructor_copy (op1->value.constructor); for (c = gfc_constructor_first (head), d = gfc_constructor_first (op2->value.constructor); @@ -2238,6 +2254,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..c13627f556b --- /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 "Invalid type" } + x = [complex :: -'1'] * (1.0, 2.0) ! { dg-error "Invalid type" } + y = [complex :: -'1'] * 2 ! { dg-error "Invalid type" } + y = 2 * [complex :: -'1'] ! { dg-error "Invalid type" } + y = 2 * [complex :: -(.true.)] ! { dg-error "Invalid type" } + y = [complex :: -(.true.)] * 2 ! { dg-error "Invalid type" } + print *, - [real :: -'1' ] ! { dg-error "Invalid type" } + print *, - [real :: [-'1']] ! { dg-error "Invalid type" } + print *, - [real :: +(.true.) ] ! { dg-error "Invalid type" } + print *, - [real :: [+(.true.)]] ! { dg-error "Invalid type" } + print *, 2 * [real :: -'1' ] ! { dg-error "Invalid type" } + print *, 2 * [real :: (-'1')] ! { dg-error "Invalid type" } + print *, [real :: -'1' ] * 2 ! { dg-error "Invalid type" } + print *, [real :: (-'1')] * 2 ! { dg-error "Invalid type" } + print *, 2 * [integer :: -('1')] ! { dg-error "Invalid type" } + print *, [integer :: -('1')] * 2 ! { dg-error "Invalid type" } + print *, 2 * [real :: 0, (-'1')] ! { dg-error "Invalid type" } + print *, [real :: 0, (-'1')] * 2 ! { dg-error "Invalid type" } + print *, 2 * [real :: 0, -'1'] ! { dg-error "Invalid type" } + print *, [real :: 0, -'1'] * 2 ! { dg-error "Invalid type" } + print *, 2 * [real :: 0, 1+'1'] ! { dg-error "Invalid type" } + print *, [real :: 0, 1+'1'] * 2 ! { dg-error "Invalid type" } + 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 "Invalid type" } + print *, [real :: 1, +(.true.)] * 2 ! { dg-error "Invalid type" } + 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 "operands are incommensurate" } + print *, [real :: 1, +(.true.)] * [real :: 1, 2] ! { dg-error "operands are incommensurate" } + print *, [real :: 0, -'1'] * [real :: 1, +(+(.true.))] ! { dg-error "operands are incommensurate" } + print *, [real :: 1, [(+(.true.))]] * [real :: 0, [(-'1')]] ! { dg-error "operands are incommensurate" } + + ! 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.3