diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 503029364c1..eb3085a05ca 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -4137,15 +4137,23 @@ convert_to_numeric (gfc_expr *a, gfc_expr *b) } /* Resolve an operator expression node. This can involve replacing the - operation with a user defined function call. */ + operation with a user defined function call. CHECK_INTERFACES is a + helper macro. */ + +#define CHECK_INTERFACES \ + { \ + match m = gfc_extend_expr (e); \ + if (m == MATCH_YES) \ + return true; \ + if (m == MATCH_ERROR) \ + return false; \ + } static bool resolve_operator (gfc_expr *e) { gfc_expr *op1, *op2; /* One error uses 3 names; additional space for wording (also via gettext). */ - char msg[3*GFC_MAX_SYMBOL_LEN + 1 + 50]; - bool dual_locus_error; bool t = true; /* Reduce stacked parentheses to single pair */ @@ -4195,8 +4203,6 @@ resolve_operator (gfc_expr *e) if (t == false) return false; - dual_locus_error = false; - /* op1 and op2 cannot both be BOZ. */ if (op1 && op1->ts.type == BT_BOZ && op2 && op2->ts.type == BT_BOZ) @@ -4210,9 +4216,9 @@ resolve_operator (gfc_expr *e) if ((op1 && op1->expr_type == EXPR_NULL) || (op2 && op2->expr_type == EXPR_NULL)) { - snprintf (msg, sizeof (msg), - _("Invalid context for NULL() pointer at %%L")); - goto bad_op; + CHECK_INTERFACES + gfc_error ("Invalid context for NULL() pointer at %L", &e->where); + return false; } switch (e->value.op.op) @@ -4227,10 +4233,10 @@ resolve_operator (gfc_expr *e) break; } - snprintf (msg, sizeof (msg), - _("Operand of unary numeric operator %%<%s%%> at %%L is %s"), - gfc_op2string (e->value.op.op), gfc_typename (e)); - goto bad_op; + CHECK_INTERFACES + gfc_error ("Operand of unary numeric operator %<%s%> at %L is %s", + gfc_op2string (e->value.op.op), &e->where, gfc_typename (e)); + return false; case INTRINSIC_PLUS: case INTRINSIC_MINUS: @@ -4244,10 +4250,10 @@ resolve_operator (gfc_expr *e) Defer to a possibly overloading user-defined operator. */ if (!gfc_op_rank_conformable (op1, op2)) { - dual_locus_error = true; - snprintf (msg, sizeof (msg), - _("Inconsistent ranks for operator at %%L and %%L")); - goto bad_op; + CHECK_INTERFACES + gfc_error ("Inconsistent ranks for operator at %L and %L", + &op1->where, &op2->where); + return false; } gfc_type_convert_binary (e, 1); @@ -4255,16 +4261,21 @@ resolve_operator (gfc_expr *e) } if (op1->ts.type == BT_DERIVED || op2->ts.type == BT_DERIVED) - snprintf (msg, sizeof (msg), - _("Unexpected derived-type entities in binary intrinsic " - "numeric operator %%<%s%%> at %%L"), - gfc_op2string (e->value.op.op)); + { + CHECK_INTERFACES + gfc_error ("Unexpected derived-type entities in binary intrinsic " + "numeric operator %<%s%> at %L", + gfc_op2string (e->value.op.op), &e->where); + return false; + } else - snprintf (msg, sizeof(msg), - _("Operands of binary numeric operator %%<%s%%> at %%L are %s/%s"), - gfc_op2string (e->value.op.op), gfc_typename (op1), - gfc_typename (op2)); - goto bad_op; + { + CHECK_INTERFACES + gfc_error ("Operands of binary numeric operator %<%s%> at %L are %s/%s", + gfc_op2string (e->value.op.op), &e->where, gfc_typename (op1), + gfc_typename (op2)); + return false; + } case INTRINSIC_CONCAT: if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER @@ -4275,10 +4286,10 @@ resolve_operator (gfc_expr *e) break; } - snprintf (msg, sizeof (msg), - _("Operands of string concatenation operator at %%L are %s/%s"), - gfc_typename (op1), gfc_typename (op2)); - goto bad_op; + CHECK_INTERFACES + gfc_error ("Operands of string concatenation operator at %L are %s/%s", + &e->where, gfc_typename (op1), gfc_typename (op2)); + return false; case INTRINSIC_AND: case INTRINSIC_OR: @@ -4318,12 +4329,11 @@ resolve_operator (gfc_expr *e) goto simplify_op; } - snprintf (msg, sizeof (msg), - _("Operands of logical operator %%<%s%%> at %%L are %s/%s"), - gfc_op2string (e->value.op.op), gfc_typename (op1), - gfc_typename (op2)); - - goto bad_op; + CHECK_INTERFACES + gfc_error ("Operands of logical operator %<%s%> at %L are %s/%s", + gfc_op2string (e->value.op.op), &e->where, gfc_typename (op1), + gfc_typename (op2)); + return false; case INTRINSIC_NOT: /* Logical ops on integers become bitwise ops with -fdec. */ @@ -4342,9 +4352,10 @@ resolve_operator (gfc_expr *e) break; } - snprintf (msg, sizeof (msg), _("Operand of .not. operator at %%L is %s"), - gfc_typename (op1)); - goto bad_op; + CHECK_INTERFACES + gfc_error ("Operand of .not. operator at %L is %s", &e->where, + gfc_typename (op1)); + return false; case INTRINSIC_GT: case INTRINSIC_GT_OS: @@ -4356,8 +4367,9 @@ resolve_operator (gfc_expr *e) case INTRINSIC_LE_OS: if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX) { - strcpy (msg, _("COMPLEX quantities cannot be compared at %L")); - goto bad_op; + CHECK_INTERFACES + gfc_error ("COMPLEX quantities cannot be compared at %L", &e->where); + return false; } /* Fall through. */ @@ -4427,10 +4439,10 @@ resolve_operator (gfc_expr *e) Defer to a possibly overloading user-defined operator. */ if (!gfc_op_rank_conformable (op1, op2)) { - dual_locus_error = true; - snprintf (msg, sizeof (msg), - _("Inconsistent ranks for operator at %%L and %%L")); - goto bad_op; + CHECK_INTERFACES + gfc_error ("Inconsistent ranks for operator at %L and %L", + &op1->where, &op2->where); + return false; } gfc_type_convert_binary (e, 1); @@ -4464,18 +4476,22 @@ resolve_operator (gfc_expr *e) } if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL) - snprintf (msg, sizeof (msg), - _("Logicals at %%L must be compared with %s instead of %s"), - (e->value.op.op == INTRINSIC_EQ - || e->value.op.op == INTRINSIC_EQ_OS) - ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.op)); + { + CHECK_INTERFACES + gfc_error ("Logicals at %L must be compared with %s instead of %s", + &e->where, + (e->value.op.op == INTRINSIC_EQ || e->value.op.op == INTRINSIC_EQ_OS) + ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.op)); + } else - snprintf (msg, sizeof (msg), - _("Operands of comparison operator %%<%s%%> at %%L are %s/%s"), - gfc_op2string (e->value.op.op), gfc_typename (op1), - gfc_typename (op2)); + { + CHECK_INTERFACES + gfc_error ("Operands of comparison operator %<%s%> at %L are %s/%s", + gfc_op2string (e->value.op.op), &e->where, gfc_typename (op1), + gfc_typename (op2)); + } - goto bad_op; + return false; case INTRINSIC_USER: if (e->value.op.uop->op == NULL) @@ -4483,28 +4499,29 @@ resolve_operator (gfc_expr *e) const char *name = e->value.op.uop->name; const char *guessed; guessed = lookup_uop_fuzzy (name, e->value.op.uop->ns->uop_root); + CHECK_INTERFACES if (guessed) - snprintf (msg, sizeof (msg), - _("Unknown operator %%<%s%%> at %%L; did you mean " - "%%<%s%%>?"), name, guessed); + gfc_error ("Unknown operator %<%s%> at %L; did you mean " + "%<%s%>?", name, &e->where, guessed); else - snprintf (msg, sizeof (msg), _("Unknown operator %%<%s%%> at %%L"), - name); + gfc_error ("Unknown operator %<%s%> at %L", name, &e->where); } else if (op2 == NULL) - snprintf (msg, sizeof (msg), - _("Operand of user operator %%<%s%%> at %%L is %s"), - e->value.op.uop->name, gfc_typename (op1)); + { + CHECK_INTERFACES + gfc_error ("Operand of user operator %<%s%> at %L is %s", + e->value.op.uop->name, &e->where, gfc_typename (op1)); + } else { - snprintf (msg, sizeof (msg), - _("Operands of user operator %%<%s%%> at %%L are %s/%s"), - e->value.op.uop->name, gfc_typename (op1), - gfc_typename (op2)); e->value.op.uop->op->sym->attr.referenced = 1; + CHECK_INTERFACES + gfc_error ("Operands of user operator %<%s%> at %L are %s/%s", + e->value.op.uop->name, &e->where, gfc_typename (op1), + gfc_typename (op2)); } - goto bad_op; + return false; case INTRINSIC_PARENTHESES: e->ts = op1->ts; @@ -4582,10 +4599,10 @@ resolve_operator (gfc_expr *e) e->rank = 0; /* Try user-defined operators, and otherwise throw an error. */ - dual_locus_error = true; - snprintf (msg, sizeof (msg), - _("Inconsistent ranks for operator at %%L and %%L")); - goto bad_op; + CHECK_INTERFACES + gfc_error ("Inconsistent ranks for operator at %L and %L", + &op1->where, &op2->where); + return false; } } @@ -4620,23 +4637,6 @@ simplify_op: t = true; } return t; - -bad_op: - - { - match m = gfc_extend_expr (e); - if (m == MATCH_YES) - return true; - if (m == MATCH_ERROR) - return false; - } - - if (dual_locus_error) - gfc_error (msg, &op1->where, &op2->where); - else - gfc_error (msg, &e->where); - - return false; }