aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog44
-rw-r--r--gcc/fortran/arith.cc78
-rw-r--r--gcc/fortran/gfortran.h2
-rw-r--r--gcc/fortran/trans-openmp.cc7
4 files changed, 123 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 535b9ae..fa03b33 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,47 @@
+2022-10-12 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/107217
+ * arith.cc (gfc_arith_plus): Compare consistency of types of operands.
+ (gfc_arith_minus): Likewise.
+ (gfc_arith_times): Likewise.
+ (gfc_arith_divide): Likewise.
+ (arith_power): Check that both operands are of numeric type.
+
+2022-10-11 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/107215
+ * arith.cc (gfc_int2int): Check validity of type of source expr.
+ (gfc_int2real): Likewise.
+ (gfc_int2complex): Likewise.
+ (gfc_real2int): Likewise.
+ (gfc_real2real): Likewise.
+ (gfc_complex2int): Likewise.
+ (gfc_complex2real): Likewise.
+ (gfc_complex2complex): Likewise.
+ (gfc_log2log): Likewise.
+ (gfc_log2int): Likewise.
+ (gfc_int2log): Likewise.
+
+2022-10-10 Jakub Jelinek <jakub@redhat.com>
+
+ * trans-openmp.cc (gfc_trans_omp_assume): Use create_tmp_var_raw
+ instead of gfc_create_var for TARGET_EXPR slot creation. Create it
+ with boolean_type_node and convert.
+
+2022-10-08 Harald Anlauf <anlauf@gmx.de>
+ Mikael Morin <mikael@gcc.gnu.org>
+
+ 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.
+
2022-10-06 Tobias Burnus <tobias@codesourcery.com>
* trans-openmp.cc (gfc_trans_omp_assume): New.
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index d57059a..14ba931 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");
@@ -621,6 +624,9 @@ gfc_arith_plus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
gfc_expr *result;
arith rc;
+ if (op1->ts.type != op2->ts.type)
+ return ARITH_INVALID_TYPE;
+
result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
switch (op1->ts.type)
@@ -655,6 +661,9 @@ gfc_arith_minus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
gfc_expr *result;
arith rc;
+ if (op1->ts.type != op2->ts.type)
+ return ARITH_INVALID_TYPE;
+
result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
switch (op1->ts.type)
@@ -689,6 +698,9 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
gfc_expr *result;
arith rc;
+ if (op1->ts.type != op2->ts.type)
+ return ARITH_INVALID_TYPE;
+
result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
switch (op1->ts.type)
@@ -724,6 +736,9 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
gfc_expr *result;
arith rc;
+ if (op1->ts.type != op2->ts.type)
+ return ARITH_INVALID_TYPE;
+
rc = ARITH_OK;
result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
@@ -812,6 +827,9 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
gfc_expr *result;
arith rc;
+ if (!gfc_numeric_ts (&op1->ts) || !gfc_numeric_ts (&op2->ts))
+ return ARITH_INVALID_TYPE;
+
rc = ARITH_OK;
result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
@@ -1268,7 +1286,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 +1330,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 +1384,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 +1445,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 +1668,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)
@@ -2023,6 +2055,9 @@ gfc_int2int (gfc_expr *src, int kind)
gfc_expr *result;
arith rc;
+ if (src->ts.type != BT_INTEGER)
+ return NULL;
+
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
mpz_set (result->value.integer, src->value.integer);
@@ -2068,6 +2103,9 @@ gfc_int2real (gfc_expr *src, int kind)
gfc_expr *result;
arith rc;
+ if (src->ts.type != BT_INTEGER)
+ return NULL;
+
result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
mpfr_set_z (result->value.real, src->value.integer, GFC_RND_MODE);
@@ -2099,6 +2137,9 @@ gfc_int2complex (gfc_expr *src, int kind)
gfc_expr *result;
arith rc;
+ if (src->ts.type != BT_INTEGER)
+ return NULL;
+
result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
mpc_set_z (result->value.complex, src->value.integer, GFC_MPC_RND_MODE);
@@ -2133,6 +2174,9 @@ gfc_real2int (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_INTEGER, kind, &src->where);
gfc_mpfr_to_mpz (result->value.integer, src->value.real, &src->where);
@@ -2179,6 +2223,9 @@ gfc_real2real (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_REAL, kind, &src->where);
mpfr_set (result->value.real, src->value.real, GFC_RND_MODE);
@@ -2238,6 +2285,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);
@@ -2290,6 +2340,9 @@ gfc_complex2int (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
+ if (src->ts.type != BT_COMPLEX)
+ return NULL;
+
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
gfc_mpfr_to_mpz (result->value.integer, mpc_realref (src->value.complex),
@@ -2352,6 +2405,9 @@ gfc_complex2real (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
+ if (src->ts.type != BT_COMPLEX)
+ return NULL;
+
result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
mpc_real (result->value.real, src->value.complex, GFC_RND_MODE);
@@ -2419,6 +2475,9 @@ gfc_complex2complex (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
+ if (src->ts.type != BT_COMPLEX)
+ return NULL;
+
result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
mpc_set (result->value.complex, src->value.complex, GFC_MPC_RND_MODE);
@@ -2484,6 +2543,9 @@ gfc_log2log (gfc_expr *src, int kind)
{
gfc_expr *result;
+ if (src->ts.type != BT_LOGICAL)
+ return NULL;
+
result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
result->value.logical = src->value.logical;
@@ -2498,6 +2560,9 @@ gfc_log2int (gfc_expr *src, int kind)
{
gfc_expr *result;
+ if (src->ts.type != BT_LOGICAL)
+ return NULL;
+
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
mpz_set_si (result->value.integer, src->value.logical);
@@ -2512,6 +2577,9 @@ gfc_int2log (gfc_expr *src, int kind)
{
gfc_expr *result;
+ if (src->ts.type != BT_INTEGER)
+ return NULL;
+
result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
result->value.logical = (mpz_cmp_si (src->value.integer, 0) != 0);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 608dda4..10bb098 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/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 8ea573f..9bd4e6c 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -4588,11 +4588,14 @@ gfc_trans_omp_assume (gfc_code *code)
t = se.expr;
else
{
- tree var = gfc_create_var (TREE_TYPE (se.expr), NULL);
+ tree var = create_tmp_var_raw (boolean_type_node);
+ DECL_CONTEXT (var) = current_function_decl;
stmtblock_t block2;
gfc_init_block (&block2);
gfc_add_block_to_block (&block2, &se.pre);
- gfc_add_modify_loc (loc, &block2, var, se.expr);
+ gfc_add_modify_loc (loc, &block2, var,
+ fold_convert_loc (loc, boolean_type_node,
+ se.expr));
gfc_add_block_to_block (&block2, &se.post);
t = gfc_finish_block (&block2);
t = build4 (TARGET_EXPR, boolean_type_node, var, t, NULL, NULL);
generated by cgit v1.1 at 2025-05-30 23:52:10 +0000