aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/primary.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/primary.c')
-rw-r--r--gcc/fortran/primary.c115
1 files changed, 52 insertions, 63 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 6664dd2..cd8a417 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -267,8 +267,7 @@ match_hollerith_constant (gfc_expr **result)
if (match_integer_constant (&e, 0) == MATCH_YES
&& gfc_match_char ('h') == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant "
- "at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant at %C"))
goto cleanup;
msg = gfc_extract_int (e, &num);
@@ -391,9 +390,8 @@ match_boz_constant (gfc_expr **result)
goto backup;
if (x_hex
- && (gfc_notify_std (GFC_STD_GNU, "Hexadecimal "
- "constant at %C uses non-standard syntax")
- == FAILURE))
+ && (!gfc_notify_std(GFC_STD_GNU, "Hexadecimal "
+ "constant at %C uses non-standard syntax")))
return MATCH_ERROR;
old_loc = gfc_current_locus;
@@ -430,9 +428,8 @@ match_boz_constant (gfc_expr **result)
goto backup;
}
- if (gfc_notify_std (GFC_STD_GNU, "BOZ constant "
- "at %C uses non-standard postfix syntax")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_GNU, "BOZ constant "
+ "at %C uses non-standard postfix syntax"))
return MATCH_ERROR;
}
@@ -467,9 +464,8 @@ match_boz_constant (gfc_expr **result)
}
if (!gfc_in_match_data ()
- && (gfc_notify_std (GFC_STD_F2003, "BOZ used outside a DATA "
- "statement at %C")
- == FAILURE))
+ && (!gfc_notify_std(GFC_STD_F2003, "BOZ used outside a DATA "
+ "statement at %C")))
return MATCH_ERROR;
*result = e;
@@ -558,8 +554,8 @@ match_real_constant (gfc_expr **result, int signflag)
if (c == 'q')
{
- if (gfc_notify_std (GFC_STD_GNU, "exponent-letter 'q' in "
- "real-literal-constant at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_GNU, "exponent-letter 'q' in "
+ "real-literal-constant at %C"))
return MATCH_ERROR;
else if (gfc_option.warn_real_q_constant)
gfc_warning("Extension: exponent-letter 'q' in real-literal-constant "
@@ -1217,8 +1213,8 @@ match_sym_complex_part (gfc_expr **result)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "PARAMETER symbol in "
- "complex constant at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "PARAMETER symbol in "
+ "complex constant at %C"))
return MATCH_ERROR;
switch (sym->value->ts.type)
@@ -1506,8 +1502,8 @@ match_actual_arg (gfc_expr **result)
if (sym->attr.in_common && !sym->attr.proc_pointer)
{
- if (gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name,
- &sym->declared_at) == FAILURE)
+ if (!gfc_add_flavor (&sym->attr, FL_VARIABLE,
+ sym->name, &sym->declared_at))
return MATCH_ERROR;
break;
}
@@ -1646,8 +1642,7 @@ match_arg_list_function (gfc_actual_arglist *result)
}
}
- if (gfc_notify_std (GFC_STD_GNU, "argument list "
- "function at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_GNU, "argument list function at %C"))
{
m = MATCH_ERROR;
goto cleanup;
@@ -1719,8 +1714,8 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp)
if (m != MATCH_YES)
goto cleanup;
- if (gfc_notify_std (GFC_STD_F95_OBS, "Alternate-return argument "
- "at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F95_OBS, "Alternate-return argument "
+ "at %C"))
goto cleanup;
tail->label = label;
@@ -1936,7 +1931,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
for (;;)
{
- gfc_try t;
+ bool t;
gfc_symtree *tbp;
m = gfc_match_name (name);
@@ -1954,7 +1949,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
{
gfc_symbol* tbp_sym;
- if (t == FAILURE)
+ if (!t)
return MATCH_ERROR;
gcc_assert (!tail || !tail->next);
@@ -2311,7 +2306,7 @@ gfc_free_structure_ctor_component (gfc_structure_ctor_component *comp)
the order required; this also checks along the way that each and every
component actually has an initializer and handles default initializers
for components without explicit value given. */
-static gfc_try
+static bool
build_actual_constructor (gfc_structure_ctor_component **comp_head,
gfc_constructor_base *ctor_head, gfc_symbol *sym)
{
@@ -2341,11 +2336,12 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
&gfc_current_locus);
value->ts = comp->ts;
- if (build_actual_constructor (comp_head, &value->value.constructor,
- comp->ts.u.derived) == FAILURE)
+ if (!build_actual_constructor (comp_head,
+ &value->value.constructor,
+ comp->ts.u.derived))
{
gfc_free_expr (value);
- return FAILURE;
+ return false;
}
gfc_constructor_append_expr (ctor_head, value, NULL);
@@ -2358,17 +2354,16 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
{
if (comp->initializer)
{
- if (gfc_notify_std (GFC_STD_F2003, "Structure"
- " constructor with missing optional arguments"
- " at %C") == FAILURE)
- return FAILURE;
+ if (!gfc_notify_std (GFC_STD_F2003, "Structure constructor "
+ "with missing optional arguments at %C"))
+ return false;
value = gfc_copy_expr (comp->initializer);
}
else
{
gfc_error ("No initializer for component '%s' given in the"
" structure constructor at %C!", comp->name);
- return FAILURE;
+ return false;
}
}
else
@@ -2386,11 +2381,11 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
gfc_free_structure_ctor_component (comp_iter);
}
}
- return SUCCESS;
+ return true;
}
-gfc_try
+bool
gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **cexpr,
gfc_actual_arglist **arglist,
bool parent)
@@ -2434,9 +2429,8 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
}
if (actual->name)
{
- if (gfc_notify_std (GFC_STD_F2003, "Structure"
- " constructor with named arguments at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "Structure"
+ " constructor with named arguments at %C"))
goto cleanup;
comp_tail->name = xstrdup (actual->name);
@@ -2519,7 +2513,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
||
comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
{
- gfc_try m;
+ bool m;
gfc_actual_arglist *arg_null = NULL;
actual->expr = comp_tail->val;
@@ -2529,7 +2523,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
comp->ts.u.derived, &comp_tail->val,
comp->ts.u.derived->attr.zero_comp
? &arg_null : &actual, true);
- if (m == FAILURE)
+ if (!m)
goto cleanup;
if (comp->ts.u.derived->attr.zero_comp)
@@ -2547,7 +2541,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
actual = actual->next;
}
- if (build_actual_constructor (&comp_head, &ctor_head, sym) == FAILURE)
+ if (!build_actual_constructor (&comp_head, &ctor_head, sym))
goto cleanup;
/* No component should be left, as this should have caused an error in the
@@ -2585,7 +2579,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
gfc_current_locus = old_locus;
if (parent)
*arglist = actual;
- return SUCCESS;
+ return true;
cleanup:
gfc_current_locus = old_locus;
@@ -2598,7 +2592,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
}
gfc_constructor_free (ctor_head);
- return FAILURE;
+ return false;
}
@@ -2627,8 +2621,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
return m;
}
- if (gfc_convert_to_structure_constructor (e, sym, NULL, NULL, false)
- != SUCCESS)
+ if (!gfc_convert_to_structure_constructor (e, sym, NULL, NULL, false))
{
gfc_free_expr (e);
return MATCH_ERROR;
@@ -2664,7 +2657,7 @@ check_for_implicit_index (gfc_symtree **st, gfc_symbol **sym)
/* Procedure pointer as function result: Replace the function symbol by the
auto-generated hidden result variable named "ppr@". */
-static gfc_try
+static bool
replace_hidden_procptr_result (gfc_symbol **sym, gfc_symtree **st)
{
/* Check for procedure pointer result variable. */
@@ -2679,9 +2672,9 @@ replace_hidden_procptr_result (gfc_symbol **sym, gfc_symtree **st)
(*sym)->result->attr.referenced = (*sym)->attr.referenced;
*sym = (*sym)->result;
*st = gfc_find_symtree ((*sym)->ns->sym_root, (*sym)->name);
- return SUCCESS;
+ return true;
}
- return FAILURE;
+ return false;
}
@@ -2708,7 +2701,7 @@ gfc_match_rvalue (gfc_expr **result)
if (m != MATCH_YES)
return m;
- if (gfc_find_state (COMP_INTERFACE) == SUCCESS
+ if (gfc_find_state (COMP_INTERFACE)
&& !gfc_current_ns->has_import_set)
i = gfc_get_sym_tree (name, NULL, &symtree, false);
else
@@ -2854,8 +2847,7 @@ gfc_match_rvalue (gfc_expr **result)
m = gfc_match_varspec (e, 0, false, true);
if (!e->ref && sym->attr.flavor == FL_UNKNOWN
&& sym->ts.type == BT_UNKNOWN
- && gfc_add_flavor (&sym->attr, FL_PROCEDURE,
- sym->name, NULL) == FAILURE)
+ && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL))
{
m = MATCH_ERROR;
break;
@@ -2930,7 +2922,7 @@ gfc_match_rvalue (gfc_expr **result)
e->rank = sym->as->rank;
if (!sym->attr.function
- && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
+ && !gfc_add_function (&sym->attr, sym->name, NULL))
{
m = MATCH_ERROR;
break;
@@ -2977,8 +2969,7 @@ gfc_match_rvalue (gfc_expr **result)
if (sym->attr.dimension || sym->attr.codimension)
{
- if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
- sym->name, NULL) == FAILURE)
+ if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL))
{
m = MATCH_ERROR;
break;
@@ -2995,8 +2986,7 @@ gfc_match_rvalue (gfc_expr **result)
&& (CLASS_DATA (sym)->attr.dimension
|| CLASS_DATA (sym)->attr.codimension))
{
- if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
- sym->name, NULL) == FAILURE)
+ if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL))
{
m = MATCH_ERROR;
break;
@@ -3021,8 +3011,7 @@ gfc_match_rvalue (gfc_expr **result)
e->symtree = symtree;
e->expr_type = EXPR_VARIABLE;
- if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
- sym->name, NULL) == FAILURE)
+ if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL))
{
m = MATCH_ERROR;
break;
@@ -3069,15 +3058,15 @@ gfc_match_rvalue (gfc_expr **result)
e->expr_type = EXPR_VARIABLE;
if (sym->attr.flavor != FL_VARIABLE
- && gfc_add_flavor (&sym->attr, FL_VARIABLE,
- sym->name, NULL) == FAILURE)
+ && !gfc_add_flavor (&sym->attr, FL_VARIABLE,
+ sym->name, NULL))
{
m = MATCH_ERROR;
break;
}
if (sym->ts.type == BT_UNKNOWN
- && gfc_set_default_type (sym, 1, NULL) == FAILURE)
+ && !gfc_set_default_type (sym, 1, NULL))
{
m = MATCH_ERROR;
break;
@@ -3098,7 +3087,7 @@ gfc_match_rvalue (gfc_expr **result)
e->expr_type = EXPR_FUNCTION;
if (!sym->attr.function
- && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
+ && !gfc_add_function (&sym->attr, sym->name, NULL))
{
m = MATCH_ERROR;
break;
@@ -3233,7 +3222,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
flavor = FL_VARIABLE;
if (flavor != FL_UNKNOWN
- && gfc_add_flavor (&sym->attr, flavor, sym->name, NULL) == FAILURE)
+ && !gfc_add_flavor (&sym->attr, flavor, sym->name, NULL))
return MATCH_ERROR;
}
break;
@@ -3269,7 +3258,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
}
if (sym->attr.proc_pointer
- || replace_hidden_procptr_result (&sym, &st) == SUCCESS)
+ || replace_hidden_procptr_result (&sym, &st))
break;
/* Fall through to error */
generated by cgit v1.1 at 2025-04-27 02:17:01 +0000