summaryrefslogtreecommitdiff
path: root/gcc/fortran/decl.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/decl.c')
-rw-r--r--gcc/fortran/decl.c677
1 files changed, 310 insertions, 367 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 3188eaeafc6..ffaa65d6a5a 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -35,7 +35,7 @@ along with GCC; see the file COPYING3. If not see
#define gfc_get_data() XCNEW (gfc_data)
-static gfc_try set_binding_label (const char **, const char *, int);
+static bool set_binding_label (const char **, const char *, int);
/* This flag is set if an old-style length selector is matched
@@ -254,8 +254,7 @@ var_element (gfc_data_variable *new_var)
sym = new_var->expr->symtree->n.sym;
/* Symbol should already have an associated type. */
- if (gfc_check_symbol_typed (sym, gfc_current_ns,
- false, gfc_current_locus) == FAILURE)
+ if (!gfc_check_symbol_typed (sym, gfc_current_ns, false, gfc_current_locus))
return MATCH_ERROR;
if (!sym->attr.function && gfc_current_ns->parent
@@ -268,12 +267,12 @@ var_element (gfc_data_variable *new_var)
if (gfc_current_state () != COMP_BLOCK_DATA
&& sym->attr.in_common
- && gfc_notify_std (GFC_STD_GNU, "initialization of "
- "common block variable '%s' in DATA statement at %C",
- sym->name) == FAILURE)
+ && !gfc_notify_std (GFC_STD_GNU, "initialization of "
+ "common block variable '%s' in DATA statement at %C",
+ sym->name))
return MATCH_ERROR;
- if (gfc_add_data (&sym->attr, sym->name, &new_var->expr->where) == FAILURE)
+ if (!gfc_add_data (&sym->attr, sym->name, &new_var->expr->where))
return MATCH_ERROR;
return MATCH_YES;
@@ -356,7 +355,7 @@ match_data_constant (gfc_expr **result)
if (m == MATCH_YES && (*result)->expr_type == EXPR_STRUCTURE)
{
- if (gfc_simplify_expr (*result, 0) == FAILURE)
+ if (!gfc_simplify_expr (*result, 0))
m = MATCH_ERROR;
return m;
}
@@ -397,7 +396,7 @@ match_data_constant (gfc_expr **result)
if (m == MATCH_YES)
{
- if (gfc_simplify_expr (*result, 0) == FAILURE)
+ if (!gfc_simplify_expr (*result, 0))
m = MATCH_ERROR;
if ((*result)->expr_type == EXPR_CONSTANT)
@@ -515,7 +514,7 @@ match_old_style_init (const char *name)
gfc_current_ns->proc_name->attr.implicit_pure = 0;
/* Mark the variable as having appeared in a data statement. */
- if (gfc_add_data (&sym->attr, sym->name, &sym->declared_at) == FAILURE)
+ if (!gfc_add_data (&sym->attr, sym->name, &sym->declared_at))
{
free (newdata);
return MATCH_ERROR;
@@ -589,7 +588,7 @@ cleanup:
/* Auxiliary function to merge DIMENSION and CODIMENSION array specs. */
-static gfc_try
+static bool
merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
{
int i;
@@ -598,7 +597,7 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
|| (to->type == AS_ASSUMED_RANK && from->corank))
{
gfc_error ("The assumed-rank array at %C shall not have a codimension");
- return FAILURE;
+ return false;
}
if (to->rank == 0 && from->rank > 0)
@@ -647,7 +646,7 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
}
}
- return SUCCESS;
+ return true;
}
@@ -686,8 +685,8 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
if (gfc_match_char (':') == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "deferred type "
- "parameter at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "deferred type "
+ "parameter at %C"))
return MATCH_ERROR;
*deferred = true;
@@ -698,7 +697,7 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
m = gfc_match_expr (expr);
if (m == MATCH_YES
- && gfc_expr_check_typed (*expr, gfc_current_ns, false) == FAILURE)
+ && !gfc_expr_check_typed (*expr, gfc_current_ns, false))
return MATCH_ERROR;
if (m == MATCH_YES && (*expr)->expr_type == EXPR_FUNCTION)
@@ -749,8 +748,7 @@ match_char_length (gfc_expr **expr, bool *deferred, bool obsolescent_check)
if (m == MATCH_YES)
{
if (obsolescent_check
- && gfc_notify_std (GFC_STD_F95_OBS,
- "Old-style character length at %C") == FAILURE)
+ && !gfc_notify_std (GFC_STD_F95_OBS, "Old-style character length at %C"))
return MATCH_ERROR;
*expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, length);
return m;
@@ -953,8 +951,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
&& sym->ns->proc_name->attr.flavor == FL_MODULE
&& sym->attr.proc != PROC_MODULE)
|| (module_fcn_entry && sym->attr.proc != PROC_MODULE))
- && gfc_add_procedure (&sym->attr, PROC_MODULE,
- sym->name, NULL) == FAILURE)
+ && !gfc_add_procedure (&sym->attr, PROC_MODULE, sym->name, NULL))
rc = 2;
return rc;
@@ -978,16 +975,16 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
the compiler could have automatically handled the varying sizes
across platforms. */
-gfc_try
+bool
gfc_verify_c_interop_param (gfc_symbol *sym)
{
int is_c_interop = 0;
- gfc_try retval = SUCCESS;
+ bool retval = true;
/* We check implicitly typed variables in symbol.c:gfc_set_default_type().
Don't repeat the checks here. */
if (sym->attr.implicit_type)
- return SUCCESS;
+ return true;
/* For subroutines or functions that are passed to a BIND(C) procedure,
they're interoperable if they're BIND(C) and their params are all
@@ -1000,13 +997,13 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
"attribute to be C interoperable", sym->name,
&(sym->declared_at));
- return FAILURE;
+ return false;
}
else
{
if (sym->attr.is_c_interop == 1)
/* We've already checked this procedure; don't check it again. */
- return SUCCESS;
+ return true;
else
return verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common,
sym->common_block);
@@ -1018,7 +1015,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
{
if (sym->ns->proc_name->attr.is_bind_c == 1)
{
- is_c_interop = (gfc_verify_c_interop (&(sym->ts)) == SUCCESS ? 1 : 0);
+ is_c_interop = (gfc_verify_c_interop(&(sym->ts)) ? 1 : 0);
if (is_c_interop != 1)
{
@@ -1057,7 +1054,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
"procedure '%s' is BIND(C)",
sym->name, &sym->declared_at,
sym->ns->proc_name->name);
- retval = FAILURE;
+ retval = false;
}
}
@@ -1070,7 +1067,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
"ALLOCATABLE attribute because procedure '%s'"
" is BIND(C)", sym->name, &(sym->declared_at),
sym->ns->proc_name->name);
- retval = FAILURE;
+ retval = false;
}
if (sym->attr.pointer == 1)
@@ -1079,7 +1076,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
"POINTER attribute because procedure '%s'"
" is BIND(C)", sym->name, &(sym->declared_at),
sym->ns->proc_name->name);
- retval = FAILURE;
+ retval = false;
}
if (sym->attr.optional == 1 && sym->attr.value)
@@ -1088,27 +1085,27 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
"and the VALUE attribute because procedure '%s' "
"is BIND(C)", sym->name, &(sym->declared_at),
sym->ns->proc_name->name);
- retval = FAILURE;
+ retval = false;
}
else if (sym->attr.optional == 1
- && gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' "
- "at %L with OPTIONAL attribute in "
- "procedure '%s' which is BIND(C)",
- sym->name, &(sym->declared_at),
- sym->ns->proc_name->name)
- == FAILURE)
- retval = FAILURE;
+ && !gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' "
+ "at %L with OPTIONAL attribute in "
+ "procedure '%s' which is BIND(C)",
+ sym->name, &(sym->declared_at),
+ sym->ns->proc_name->name))
+ retval = false;
/* Make sure that if it has the dimension attribute, that it is
either assumed size or explicit shape. Deferred shape is already
covered by the pointer/allocatable attribute. */
if (sym->as != NULL && sym->as->type == AS_ASSUMED_SHAPE
- && gfc_notify_std (GFC_STD_F2008_TS, "Assumed-shape array '%s' "
- "at %L as dummy argument to the BIND(C) "
- "procedure '%s' at %L", sym->name,
- &(sym->declared_at), sym->ns->proc_name->name,
- &(sym->ns->proc_name->declared_at)) == FAILURE)
- retval = FAILURE;
+ && !gfc_notify_std (GFC_STD_F2008_TS, "Assumed-shape array '%s' "
+ "at %L as dummy argument to the BIND(C) "
+ "procedure '%s' at %L", sym->name,
+ &(sym->declared_at),
+ sym->ns->proc_name->name,
+ &(sym->ns->proc_name->declared_at)))
+ retval = false;
}
}
@@ -1119,7 +1116,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
/* Function called by variable_decl() that adds a name to the symbol table. */
-static gfc_try
+static bool
build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
gfc_array_spec **as, locus *var_locus)
{
@@ -1127,14 +1124,14 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
gfc_symbol *sym;
if (gfc_get_symbol (name, NULL, &sym))
- return FAILURE;
+ return false;
/* Start updating the symbol table. Add basic type attribute if present. */
if (current_ts.type != BT_UNKNOWN
&& (sym->attr.implicit_type == 0
|| !gfc_compare_types (&sym->ts, &current_ts))
- && gfc_add_type (sym, &current_ts, var_locus) == FAILURE)
- return FAILURE;
+ && !gfc_add_type (sym, &current_ts, var_locus))
+ return false;
if (sym->ts.type == BT_CHARACTER)
{
@@ -1143,8 +1140,8 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
}
/* Add dimension attribute if present. */
- if (gfc_set_array_spec (sym, *as, var_locus) == FAILURE)
- return FAILURE;
+ if (!gfc_set_array_spec (sym, *as, var_locus))
+ return false;
*as = NULL;
/* Add attribute to symbol. The copy is so that we can reset the
@@ -1153,8 +1150,8 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
attr.dimension = 0;
attr.codimension = 0;
- if (gfc_copy_attr (&sym->attr, &attr, var_locus) == FAILURE)
- return FAILURE;
+ if (!gfc_copy_attr (&sym->attr, &attr, var_locus))
+ return false;
/* Finish any work that may need to be done for the binding label,
if it's a bind(c). The bind(c) attr is found before the symbol
@@ -1168,9 +1165,9 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
{
/* Set the binding label and verify that if a NAME= was specified
then only one identifier was in the entity-decl-list. */
- if (set_binding_label (&sym->binding_label, sym->name,
- num_idents_on_line) == FAILURE)
- return FAILURE;
+ if (!set_binding_label (&sym->binding_label, sym->name,
+ num_idents_on_line))
+ return false;
}
}
@@ -1196,7 +1193,7 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
if (sym->ts.type == BT_CLASS)
return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false);
- return SUCCESS;
+ return true;
}
@@ -1302,7 +1299,7 @@ gfc_free_enum_history (void)
/* Function called by variable_decl() that adds an initialization
expression to a symbol. */
-static gfc_try
+static bool
add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
{
symbol_attribute attr;
@@ -1311,7 +1308,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
init = *initp;
if (find_special (name, &sym, false))
- return FAILURE;
+ return false;
attr = sym->attr;
@@ -1323,7 +1320,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
{
gfc_error ("Initializer not allowed for PARAMETER '%s' at %C",
sym->name);
- return FAILURE;
+ return false;
}
if (init == NULL)
@@ -1332,7 +1329,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
if (attr.flavor == FL_PARAMETER)
{
gfc_error ("PARAMETER at %L is missing an initializer", var_locus);
- return FAILURE;
+ return false;
}
}
else
@@ -1343,7 +1340,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
{
gfc_error ("Variable '%s' at %C with an initializer already "
"appears in a DATA statement", sym->name);
- return FAILURE;
+ return false;
}
/* Check if the assignment can happen. This has to be put off
@@ -1351,15 +1348,15 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
if (sym->ts.type != BT_DERIVED && init->ts.type != BT_DERIVED
&& sym->ts.type != BT_CLASS && init->ts.type != BT_CLASS
&& !sym->attr.proc_pointer
- && gfc_check_assign_symbol (sym, NULL, init) == FAILURE)
- return FAILURE;
+ && !gfc_check_assign_symbol (sym, NULL, init))
+ return false;
if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl
&& init->ts.type == BT_CHARACTER)
{
/* Update symbol character length according initializer. */
- if (gfc_check_assign_symbol (sym, NULL, init) == FAILURE)
- return FAILURE;
+ if (!gfc_check_assign_symbol (sym, NULL, init))
+ return false;
if (sym->ts.u.cl->length == NULL)
{
@@ -1424,7 +1421,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
{
gfc_error ("Can't initialize implied-shape array at %L"
" with scalar", &sym->declared_at);
- return FAILURE;
+ return false;
}
gcc_assert (sym->as->rank == init->rank);
@@ -1442,7 +1439,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
{
gfc_error ("Non-constant lower bound in implied-shape"
" declaration at %L", &lower->where);
- return FAILURE;
+ return false;
}
/* All dimensions must be without upper bound. */
@@ -1487,7 +1484,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
int n;
if (sym->attr.flavor == FL_PARAMETER
&& init->expr_type == EXPR_CONSTANT
- && spec_size (sym->as, &size) == SUCCESS
+ && spec_size (sym->as, &size)
&& mpz_cmp_si (size, 0) > 0)
{
array = gfc_get_array_expr (init->ts.type, init->ts.kind,
@@ -1515,19 +1512,19 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
*initp = NULL;
}
- return SUCCESS;
+ return true;
}
/* Function called by variable_decl() that adds a name to a structure
being built. */
-static gfc_try
+static bool
build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
gfc_array_spec **as)
{
gfc_component *c;
- gfc_try t = SUCCESS;
+ bool t = true;
/* F03:C438/C439. If the current symbol is of the same derived type that we're
constructing, it must have the pointer attribute. */
@@ -1536,7 +1533,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
&& current_attr.pointer == 0)
{
gfc_error ("Component at %C must have the POINTER attribute");
- return FAILURE;
+ return false;
}
if (gfc_current_block ()->attr.pointer && (*as)->rank != 0)
@@ -1545,12 +1542,12 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
{
gfc_error ("Array component of structure at %C must have explicit "
"or deferred shape");
- return FAILURE;
+ return false;
}
}
- if (gfc_add_component (gfc_current_block (), name, &c) == FAILURE)
- return FAILURE;
+ if (!gfc_add_component (gfc_current_block(), name, &c))
+ return false;
c->ts = current_ts;
if (c->ts.type == BT_CHARACTER)
@@ -1626,7 +1623,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
{
gfc_error ("Pointer array component of structure at %C must have a "
"deferred shape");
- t = FAILURE;
+ t = false;
}
}
else if (c->attr.allocatable)
@@ -1635,7 +1632,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
{
gfc_error ("Allocatable component of structure at %C must have a "
"deferred shape");
- t = FAILURE;
+ t = false;
}
}
else
@@ -1644,7 +1641,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
{
gfc_error ("Array component of structure at %C must have an "
"explicit shape");
- t = FAILURE;
+ t = false;
}
}
@@ -1654,9 +1651,9 @@ scalar:
bool delayed = (gfc_state_stack->sym == c->ts.u.derived)
|| (!c->ts.u.derived->components
&& !c->ts.u.derived->attr.zero_comp);
- gfc_try t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as, delayed);
+ bool t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as, delayed);
- if (t != FAILURE)
+ if (t)
t = t2;
}
@@ -1706,9 +1703,8 @@ gfc_match_null (gfc_expr **result)
gfc_intrinsic_symbol (sym);
if (sym->attr.proc != PROC_INTRINSIC
- && (gfc_add_procedure (&sym->attr, PROC_INTRINSIC,
- sym->name, NULL) == FAILURE
- || gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE))
+ && (!gfc_add_procedure(&sym->attr, PROC_INTRINSIC, sym->name, NULL)
+ || !gfc_add_function (&sym->attr, sym->name, NULL)))
return MATCH_ERROR;
*result = gfc_get_null_expr (&gfc_current_locus);
@@ -1760,15 +1756,15 @@ match_pointer_init (gfc_expr **init, int procptr)
if (!procptr)
gfc_resolve_expr (*init);
- if (gfc_notify_std (GFC_STD_F2008, "non-NULL pointer "
- "initialization at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2008, "non-NULL pointer "
+ "initialization at %C"))
return MATCH_ERROR;
return MATCH_YES;
}
-static gfc_try
+static bool
check_function_name (char *name)
{
/* In functions that have a RESULT variable defined, the function name always
@@ -1784,11 +1780,11 @@ check_function_name (char *name)
&& strcmp (block->name, name) == 0)
{
gfc_error ("Function name '%s' not allowed at %C", name);
- return FAILURE;
+ return false;
}
}
- return SUCCESS;
+ return true;
}
@@ -1808,7 +1804,7 @@ variable_decl (int elem)
bool cl_deferred;
locus var_locus;
match m;
- gfc_try t;
+ bool t;
gfc_symbol *sym;
initializer = NULL;
@@ -1832,7 +1828,7 @@ variable_decl (int elem)
if (m == MATCH_NO)
as = gfc_copy_array_spec (current_as);
else if (current_as
- && merge_array_spec (current_as, as, true) == FAILURE)
+ && !merge_array_spec (current_as, as, true))
{
m = MATCH_ERROR;
goto cleanup;
@@ -1860,9 +1856,8 @@ variable_decl (int elem)
as->type = AS_IMPLIED_SHAPE;
if (as->type == AS_IMPLIED_SHAPE
- && gfc_notify_std (GFC_STD_F2008,
- "Implied-shape array at %L",
- &var_locus) == FAILURE)
+ && !gfc_notify_std (GFC_STD_F2008, "Implied-shape array at %L",
+ &var_locus))
{
m = MATCH_ERROR;
goto cleanup;
@@ -1932,7 +1927,7 @@ variable_decl (int elem)
}
else
{
- if (gfc_set_array_spec (sym, cp_as, &var_locus) == FAILURE)
+ if (!gfc_set_array_spec (sym, cp_as, &var_locus))
gfc_internal_error ("Couldn't set pointee array spec.");
/* Fix the array spec. */
@@ -1973,13 +1968,13 @@ variable_decl (int elem)
create a symbol for those yet. If we fail to create the symbol,
bail out. */
if (gfc_current_state () != COMP_DERIVED
- && build_sym (name, cl, cl_deferred, &as, &var_locus) == FAILURE)
+ && !build_sym (name, cl, cl_deferred, &as, &var_locus))
{
m = MATCH_ERROR;
goto cleanup;
}
- if (check_function_name (name) == FAILURE)
+ if (!check_function_name (name))
{
m = MATCH_ERROR;
goto cleanup;
@@ -1996,8 +1991,8 @@ variable_decl (int elem)
if (!colon_seen && gfc_match (" /") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_GNU, "Old-style "
- "initialization at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_GNU, "Old-style "
+ "initialization at %C"))
return MATCH_ERROR;
return match_old_style_init (name);
@@ -2072,7 +2067,7 @@ variable_decl (int elem)
t = build_struct (name, cl, &initializer, &as);
}
- m = (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
+ m = (t) ? MATCH_YES : MATCH_ERROR;
cleanup:
/* Free stuff up and return. */
@@ -2148,8 +2143,9 @@ gfc_match_old_kind_spec (gfc_typespec *ts)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_GNU, "Nonstandard type declaration %s*%d at %C",
- gfc_basic_typename (ts->type), original_kind) == FAILURE)
+ if (!gfc_notify_std (GFC_STD_GNU,
+ "Nonstandard type declaration %s*%d at %C",
+ gfc_basic_typename(ts->type), original_kind))
return MATCH_ERROR;
return MATCH_YES;
@@ -2589,8 +2585,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
if (gfc_match (" byte") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_GNU, "BYTE type at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_GNU, "BYTE type at %C"))
return MATCH_ERROR;
if (gfc_validate_kind (BT_INTEGER, 1, true) < 0)
@@ -2620,8 +2615,8 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
gfc_error ("Assumed type at %C is not allowed for components");
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2008_TS, "Assumed type "
- "at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2008_TS, "Assumed type "
+ "at %C"))
return MATCH_ERROR;
ts->type = BT_ASSUMED;
return MATCH_YES;
@@ -2643,8 +2638,8 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
|| (!matched_type && gfc_match (" character") == MATCH_YES))
{
if (matched_type
- && gfc_notify_std (GFC_STD_F2008, "TYPE with "
- "intrinsic-type-spec at %C") == FAILURE)
+ && !gfc_notify_std (GFC_STD_F2008, "TYPE with "
+ "intrinsic-type-spec at %C"))
return MATCH_ERROR;
ts->type = BT_CHARACTER;
@@ -2674,8 +2669,8 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
|| (!matched_type && gfc_match (" double precision") == MATCH_YES))
{
if (matched_type
- && gfc_notify_std (GFC_STD_F2008, "TYPE with "
- "intrinsic-type-spec at %C") == FAILURE)
+ && !gfc_notify_std (GFC_STD_F2008, "TYPE with "
+ "intrinsic-type-spec at %C"))
return MATCH_ERROR;
if (matched_type && gfc_match_char (')') != MATCH_YES)
return MATCH_ERROR;
@@ -2699,13 +2694,12 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
&& gfc_match (" complex") == MATCH_YES)))
|| (!matched_type && gfc_match (" double complex") == MATCH_YES))
{
- if (gfc_notify_std (GFC_STD_GNU, "DOUBLE COMPLEX at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_GNU, "DOUBLE COMPLEX at %C"))
return MATCH_ERROR;
if (matched_type
- && gfc_notify_std (GFC_STD_F2008, "TYPE with "
- "intrinsic-type-spec at %C") == FAILURE)
+ && !gfc_notify_std (GFC_STD_F2008, "TYPE with "
+ "intrinsic-type-spec at %C"))
return MATCH_ERROR;
if (matched_type && gfc_match_char (')') != MATCH_YES)
@@ -2753,8 +2747,8 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
/* This is essential to force the construction of
unlimited polymorphic component class containers. */
upe->attr.zero_comp = 1;
- if (gfc_add_flavor (&upe->attr, FL_DERIVED,
- NULL, &gfc_current_locus) == FAILURE)
+ if (!gfc_add_flavor (&upe->attr, FL_DERIVED, NULL,
+ &gfc_current_locus))
return MATCH_ERROR;
}
else
@@ -2774,8 +2768,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
return m;
ts->type = BT_CLASS;
- if (gfc_notify_std (GFC_STD_F2003, "CLASS statement at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "CLASS statement at %C"))
return MATCH_ERROR;
}
@@ -2846,11 +2839,11 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
gfc_set_sym_referenced (sym);
if (!sym->attr.generic
- && gfc_add_generic (&sym->attr, sym->name, NULL) == FAILURE)
+ && !gfc_add_generic (&sym->attr, sym->name, NULL))
return MATCH_ERROR;
if (!sym->attr.function
- && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
+ && !gfc_add_function (&sym->attr, sym->name, NULL))
return MATCH_ERROR;
if (!dt_sym)
@@ -2872,8 +2865,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
gfc_set_sym_referenced (dt_sym);
if (dt_sym->attr.flavor != FL_DERIVED
- && gfc_add_flavor (&dt_sym->attr, FL_DERIVED, sym->name, NULL)
- == FAILURE)
+ && !gfc_add_flavor (&dt_sym->attr, FL_DERIVED, sym->name, NULL))
return MATCH_ERROR;
ts->u.derived = dt_sym;
@@ -2882,8 +2874,8 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
get_kind:
if (matched_type
- && gfc_notify_std (GFC_STD_F2008, "TYPE with "
- "intrinsic-type-spec at %C") == FAILURE)
+ && !gfc_notify_std (GFC_STD_F2008, "TYPE with "
+ "intrinsic-type-spec at %C"))
return MATCH_ERROR;
/* For all types except double, derived and character, look for an
@@ -3014,7 +3006,7 @@ match_implicit_range (void)
conflicts with whatever earlier IMPLICIT statements may have
set. This is done when we've successfully finished matching
the current one. */
- if (gfc_add_new_implicit_range (c1, c2) != SUCCESS)
+ if (!gfc_add_new_implicit_range (c1, c2))
goto bad;
}
@@ -3096,7 +3088,7 @@ gfc_match_implicit (void)
}
/* Record the Successful match. */
- if (gfc_merge_new_implicit (&ts) != SUCCESS)
+ if (!gfc_merge_new_implicit (&ts))
return MATCH_ERROR;
continue;
}
@@ -3136,7 +3128,7 @@ gfc_match_implicit (void)
if ((c != '\n') && (c != ','))
goto syntax;
- if (gfc_merge_new_implicit (&ts) != SUCCESS)
+ if (!gfc_merge_new_implicit (&ts))
return MATCH_ERROR;
}
while (c == ',');
@@ -3167,8 +3159,7 @@ gfc_match_import (void)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "IMPORT statement at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "IMPORT statement at %C"))
return MATCH_ERROR;
if (gfc_match_eos () == MATCH_YES)
@@ -3313,7 +3304,7 @@ match_attr_spec (void)
unsigned int d;
const char *attr;
match m;
- gfc_try t;
+ bool t;
gfc_clear_attr (&current_attr);
start = gfc_current_locus;
@@ -3552,7 +3543,7 @@ match_attr_spec (void)
current_as = as;
else if (m == MATCH_YES)
{
- if (merge_array_spec (as, current_as, false) == FAILURE)
+ if (!merge_array_spec (as, current_as, false))
m = MATCH_ERROR;
free (as);
}
@@ -3664,9 +3655,8 @@ match_attr_spec (void)
{
if (d == DECL_ALLOCATABLE)
{
- if (gfc_notify_std (GFC_STD_F2003, "ALLOCATABLE "
- "attribute at %C in a TYPE definition")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "ALLOCATABLE "
+ "attribute at %C in a TYPE definition"))
{
m = MATCH_ERROR;
goto cleanup;
@@ -3692,10 +3682,9 @@ match_attr_spec (void)
&& gfc_state_stack->previous
&& gfc_state_stack->previous->state == COMP_MODULE)
{
- if (gfc_notify_std (GFC_STD_F2003, "Attribute %s "
- "at %L in a TYPE definition", attr,
- &seen_at[d])
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "Attribute %s "
+ "at %L in a TYPE definition", attr,
+ &seen_at[d]))
{
m = MATCH_ERROR;
goto cleanup;
@@ -3717,10 +3706,8 @@ match_attr_spec (void)
break;
case DECL_ASYNCHRONOUS:
- if (gfc_notify_std (GFC_STD_F2003,
- "ASYNCHRONOUS attribute at %C")
- == FAILURE)
- t = FAILURE;
+ if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS attribute at %C"))
+ t = false;
else
t = gfc_add_asynchronous (&current_attr, NULL, &seen_at[d]);
break;
@@ -3730,10 +3717,8 @@ match_attr_spec (void)
break;
case DECL_CONTIGUOUS:
- if (gfc_notify_std (GFC_STD_F2008,
- "CONTIGUOUS attribute at %C")
- == FAILURE)
- t = FAILURE;
+ if (!gfc_notify_std (GFC_STD_F2008, "CONTIGUOUS attribute at %C"))
+ t = false;
else
t = gfc_add_contiguous (&current_attr, NULL, &seen_at[d]);
break;
@@ -3779,14 +3764,12 @@ match_attr_spec (void)
{
gfc_error ("PROTECTED at %C only allowed in specification "
"part of a module");
- t = FAILURE;
+ t = false;
break;
}
- if (gfc_notify_std (GFC_STD_F2003, "PROTECTED "
- "attribute at %C")
- == FAILURE)
- t = FAILURE;
+ if (!gfc_notify_std (GFC_STD_F2003, "PROTECTED attribute at %C"))
+ t = false;
else
t = gfc_add_protected (&current_attr, NULL, &seen_at[d]);
break;
@@ -3814,19 +3797,15 @@ match_attr_spec (void)
break;
case DECL_VALUE:
- if (gfc_notify_std (GFC_STD_F2003, "VALUE attribute "
- "at %C")
- == FAILURE)
- t = FAILURE;
+ if (!gfc_notify_std (GFC_STD_F2003, "VALUE attribute at %C"))
+ t = false;
else
t = gfc_add_value (&current_attr, NULL, &seen_at[d]);
break;
case DECL_VOLATILE:
- if (gfc_notify_std (GFC_STD_F2003,
- "VOLATILE attribute at %C")
- == FAILURE)
- t = FAILURE;
+ if (!gfc_notify_std (GFC_STD_F2003, "VOLATILE attribute at %C"))
+ t = false;
else
t = gfc_add_volatile (&current_attr, NULL, &seen_at[d]);
break;
@@ -3835,7 +3814,7 @@ match_attr_spec (void)
gfc_internal_error ("match_attr_spec(): Bad attribute");
}
- if (t == FAILURE)
+ if (!t)
{
m = MATCH_ERROR;
goto cleanup;
@@ -3864,7 +3843,7 @@ cleanup:
(J3/04-007, section 15.4.1). If a binding label was given and
there is more than one argument (num_idents), it is an error. */
-static gfc_try
+static bool
set_binding_label (const char **dest_label, const char *sym_name,
int num_idents)
{
@@ -3872,7 +3851,7 @@ set_binding_label (const char **dest_label, const char *sym_name,
{
gfc_error ("Multiple identifiers provided with "
"single NAME= specifier at %C");
- return FAILURE;
+ return false;
}
if (curr_binding_label)
@@ -3886,7 +3865,7 @@ set_binding_label (const char **dest_label, const char *sym_name,
*dest_label = IDENTIFIER_POINTER (get_identifier (sym_name));
}
- return SUCCESS;
+ return true;
}
@@ -3903,18 +3882,18 @@ set_com_block_bind_c (gfc_common_head *com_block, int is_bind_c)
/* Verify that the given gfc_typespec is for a C interoperable type. */
-gfc_try
+bool
gfc_verify_c_interop (gfc_typespec *ts)
{
if (ts->type == BT_DERIVED && ts->u.derived != NULL)
return (ts->u.derived->ts.is_c_interop || ts->u.derived->attr.is_bind_c)
- ? SUCCESS : FAILURE;
+ ? true : false;
else if (ts->type == BT_CLASS)
- return FAILURE;
+ return false;
else if (ts->is_c_interop != 1 && ts->type != BT_ASSUMED)
- return FAILURE;
+ return false;
- return SUCCESS;
+ return true;
}
@@ -3923,11 +3902,11 @@ gfc_verify_c_interop (gfc_typespec *ts)
interoperable type. Errors will be reported here, if
encountered. */
-gfc_try
+bool
verify_com_block_vars_c_interop (gfc_common_head *com_block)
{
gfc_symbol *curr_sym = NULL;
- gfc_try retval = SUCCESS;
+ bool retval = true;
curr_sym = com_block->head;
@@ -3951,12 +3930,12 @@ verify_com_block_vars_c_interop (gfc_common_head *com_block)
/* Verify that a given BIND(C) symbol is C interoperable. If it is not,
an appropriate error message is reported. */
-gfc_try
+bool
verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
int is_in_common, gfc_common_head *com_block)
{
bool bind_c_function = false;
- gfc_try retval = SUCCESS;
+ bool retval = true;
if (tmp_sym->attr.function && tmp_sym->attr.is_bind_c)
bind_c_function = true;
@@ -3983,7 +3962,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
the given ts (current_ts), so look in both. */
if (tmp_sym->ts.type != BT_UNKNOWN || ts->type != BT_UNKNOWN)
{
- if (gfc_verify_c_interop (&(tmp_sym->ts)) != SUCCESS)
+ if (!gfc_verify_c_interop (&(tmp_sym->ts)))
{
/* See if we're dealing with a sym in a common block or not. */
if (is_in_common == 1 && gfc_option.warn_c_binding_type)
@@ -4018,7 +3997,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
"since it is not a global",
tmp_sym->name, com_block->name,
&(tmp_sym->declared_at));
- retval = FAILURE;
+ retval = false;
}
/* Scalar variables that are bind(c) can not have the pointer
@@ -4030,7 +4009,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
gfc_error ("Variable '%s' at %L cannot have both the "
"POINTER and BIND(C) attributes",
tmp_sym->name, &(tmp_sym->declared_at));
- retval = FAILURE;
+ retval = false;
}
if (tmp_sym->attr.allocatable == 1)
@@ -4038,7 +4017,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
gfc_error ("Variable '%s' at %L cannot have both the "
"ALLOCATABLE and BIND(C) attributes",
tmp_sym->name, &(tmp_sym->declared_at));
- retval = FAILURE;
+ retval = false;
}
}
@@ -4079,19 +4058,18 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
the type is C interoperable. Errors are reported by the functions
used to set/test these fields. */
-gfc_try
+bool
set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents)
{
- gfc_try retval = SUCCESS;
+ bool retval = true;
/* TODO: Do we need to make sure the vars aren't marked private? */
/* Set the is_bind_c bit in symbol_attribute. */
gfc_add_is_bind_c (&(tmp_sym->attr), tmp_sym->name, &gfc_current_locus, 0);
- if (set_binding_label (&tmp_sym->binding_label, tmp_sym->name,
- num_idents) != SUCCESS)
- return FAILURE;
+ if (!set_binding_label (&tmp_sym->binding_label, tmp_sym->name, num_idents))
+ return false;
return retval;
}
@@ -4100,16 +4078,15 @@ set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents)
/* Set the fields marking the given common block as BIND(C), including
a binding label, and report any errors encountered. */
-gfc_try
+bool
set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents)
{
- gfc_try retval = SUCCESS;
+ bool retval = true;
/* destLabel, common name, typespec (which may have binding label). */
- if (set_binding_label (&com_block->binding_label, com_block->name,
- num_idents)
- != SUCCESS)
- return FAILURE;
+ if (!set_binding_label (&com_block->binding_label, com_block->name,
+ num_idents))
+ return false;
/* Set the given common block (com_block) to being bind(c) (1). */
set_com_block_bind_c (com_block, 1);
@@ -4121,7 +4098,7 @@ set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents)
/* Retrieve the list of one or more identifiers that the given bind(c)
attribute applies to. */
-gfc_try
+bool
get_bind_c_idents (void)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
@@ -4144,7 +4121,7 @@ get_bind_c_idents (void)
{
gfc_error ("Need either entity or common block name for "
"attribute specification statement at %C");
- return FAILURE;
+ return false;
}
/* Save the current identifier and look for more. */
@@ -4160,15 +4137,13 @@ get_bind_c_idents (void)
{
if (tmp_sym != NULL)
{
- if (set_verify_bind_c_sym (tmp_sym, num_idents)
- != SUCCESS)
- return FAILURE;
+ if (!set_verify_bind_c_sym (tmp_sym, num_idents))
+ return false;
}
else
{
- if (set_verify_bind_c_com_block(com_block, num_idents)
- != SUCCESS)
- return FAILURE;
+ if (!set_verify_bind_c_com_block (com_block, num_idents))
+ return false;
}
/* Look to see if we have another identifier. */
@@ -4191,7 +4166,7 @@ get_bind_c_idents (void)
{
gfc_error ("Missing entity or common block name for "
"attribute specification statement at %C");
- return FAILURE;
+ return false;
}
}
else
@@ -4201,7 +4176,7 @@ get_bind_c_idents (void)
} while (found_id == MATCH_YES);
/* if we get here we were successful */
- return SUCCESS;
+ return true;
}
@@ -4233,7 +4208,7 @@ gfc_match_bind_c_stmt (void)
found can have all appropriate parts updated (assuming that the same
spec stmt can have multiple attrs, such as both bind(c) and
allocatable...). */
- if (get_bind_c_idents () != SUCCESS)
+ if (!get_bind_c_idents ())
/* Error message should have printed already. */
return MATCH_ERROR;
}
@@ -4380,7 +4355,7 @@ gfc_match_prefix (gfc_typespec *ts)
if (gfc_match ("elemental% ") == MATCH_YES)
{
- if (gfc_add_elemental (&current_attr, NULL) == FAILURE)
+ if (!gfc_add_elemental (&current_attr, NULL))
goto error;
found_prefix = true;
@@ -4388,7 +4363,7 @@ gfc_match_prefix (gfc_typespec *ts)
if (gfc_match ("pure% ") == MATCH_YES)
{
- if (gfc_add_pure (&current_attr, NULL) == FAILURE)
+ if (!gfc_add_pure (&current_attr, NULL))
goto error;
found_prefix = true;
@@ -4396,7 +4371,7 @@ gfc_match_prefix (gfc_typespec *ts)
if (gfc_match ("recursive% ") == MATCH_YES)
{
- if (gfc_add_recursive (&current_attr, NULL) == FAILURE)
+ if (!gfc_add_recursive (&current_attr, NULL))
goto error;
found_prefix = true;
@@ -4407,9 +4382,7 @@ gfc_match_prefix (gfc_typespec *ts)
automatically PURE. */
if (gfc_match ("impure% ") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2008,
- "IMPURE procedure at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2008, "IMPURE procedure at %C"))
goto error;
seen_impure = true;
@@ -4428,7 +4401,7 @@ gfc_match_prefix (gfc_typespec *ts)
/* If IMPURE it not seen but the procedure is ELEMENTAL, mark it as PURE. */
if (!seen_impure && current_attr.elemental && !current_attr.pure)
{
- if (gfc_add_pure (&current_attr, NULL) == FAILURE)
+ if (!gfc_add_pure (&current_attr, NULL))
goto error;
}
@@ -4446,19 +4419,19 @@ error:
/* Copy attributes matched by gfc_match_prefix() to attributes on a symbol. */
-static gfc_try
+static bool
copy_prefix (symbol_attribute *dest, locus *where)
{
- if (current_attr.pure && gfc_add_pure (dest, where) == FAILURE)
- return FAILURE;
+ if (current_attr.pure && !gfc_add_pure (dest, where))
+ return false;
- if (current_attr.elemental && gfc_add_elemental (dest, where) == FAILURE)
- return FAILURE;
+ if (current_attr.elemental && !gfc_add_elemental (dest, where))
+ return false;
- if (current_attr.recursive && gfc_add_recursive (dest, where) == FAILURE)
- return FAILURE;
+ if (current_attr.recursive && !gfc_add_recursive (dest, where))
+ return false;
- return SUCCESS;
+ return true;
}
@@ -4489,8 +4462,8 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, int null_flag)
if (gfc_match_char ('*') == MATCH_YES)
{
sym = NULL;
- 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"))
{
m = MATCH_ERROR;
goto cleanup;
@@ -4522,8 +4495,8 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, int null_flag)
dummy procedure. We don't apply these attributes to formal
arguments of statement functions. */
if (sym != NULL && !st_flag
- && (gfc_add_dummy (&sym->attr, sym->name, NULL) == FAILURE
- || gfc_missing_attr (&sym->attr, NULL) == FAILURE))
+ && (!gfc_add_dummy(&sym->attr, sym->name, NULL)
+ || !gfc_missing_attr (&sym->attr, NULL)))
{
m = MATCH_ERROR;
goto cleanup;
@@ -4573,8 +4546,7 @@ ok:
}
}
- if (gfc_add_explicit_interface (progname, IFSRC_DECL, head, NULL)
- == FAILURE)
+ if (!gfc_add_explicit_interface (progname, IFSRC_DECL, head, NULL))
{
m = MATCH_ERROR;
goto cleanup;
@@ -4607,7 +4579,7 @@ match_result (gfc_symbol *function, gfc_symbol **result)
/* Get the right paren, and that's it because there could be the
bind(c) attribute after the result clause. */
- if (gfc_match_char(')') != MATCH_YES)
+ if (gfc_match_char (')') != MATCH_YES)
{
/* TODO: should report the missing right paren here. */
return MATCH_ERROR;
@@ -4622,7 +4594,7 @@ match_result (gfc_symbol *function, gfc_symbol **result)
if (gfc_get_symbol (name, NULL, &r))
return MATCH_ERROR;
- if (gfc_add_result (&r->attr, r->name, NULL) == FAILURE)
+ if (!gfc_add_result (&r->attr, r->name, NULL))
return MATCH_ERROR;
*result = r;
@@ -4702,14 +4674,12 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result)
/* Fortran 2008 draft allows BIND(C) for internal procedures. */
if (gfc_current_state () == COMP_CONTAINS
&& sym->ns->proc_name->attr.flavor != FL_MODULE
- && gfc_notify_std (GFC_STD_F2008, "BIND(C) attribute "
- "at %L may not be specified for an internal "
- "procedure", &gfc_current_locus)
- == FAILURE)
+ && !gfc_notify_std (GFC_STD_F2008, "BIND(C) attribute "
+ "at %L may not be specified for an internal "
+ "procedure", &gfc_current_locus))
return MATCH_ERROR;
- if (gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1)
- == FAILURE)
+ if (!gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1))
return MATCH_ERROR;
}
@@ -4720,13 +4690,13 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result)
/* Procedure pointer return value without RESULT statement:
Add "hidden" result variable named "ppr@". */
-static gfc_try
+static bool
add_hidden_procptr_result (gfc_symbol *sym)
{
bool case1,case2;
if (gfc_notification_std (GFC_STD_F2003) == ERROR)
- return FAILURE;
+ return false;
/* First usage case: PROCEDURE and EXTERNAL statements. */
case1 = gfc_current_state () == COMP_FUNCTION && gfc_current_block ()
@@ -4776,10 +4746,10 @@ add_hidden_procptr_result (gfc_symbol *sym)
{
sym->result->attr.proc_pointer = 1;
sym->attr.pointer = 0;
- return SUCCESS;
+ return true;
}
else
- return FAILURE;
+ return false;
}
@@ -4845,8 +4815,8 @@ match_procedure_interface (gfc_symbol **proc_if)
if ((*proc_if)->attr.flavor == FL_UNKNOWN
&& (*proc_if)->ts.type == BT_UNKNOWN
- && gfc_add_flavor (&(*proc_if)->attr, FL_PROCEDURE,
- (*proc_if)->name, NULL) == FAILURE)
+ && !gfc_add_flavor (&(*proc_if)->attr, FL_PROCEDURE,
+ (*proc_if)->name, NULL))
return MATCH_ERROR;
}
@@ -4898,7 +4868,7 @@ match_procedure_decl (void)
return m;
/* Add current_attr to the symbol attributes. */
- if (gfc_copy_attr (&sym->attr, &current_attr, NULL) == FAILURE)
+ if (!gfc_copy_attr (&sym->attr, &current_attr, NULL))
return MATCH_ERROR;
if (sym->attr.is_bind_c)
@@ -4924,18 +4894,17 @@ match_procedure_decl (void)
return MATCH_ERROR;
}
/* Set binding label for BIND(C). */
- if (set_binding_label (&sym->binding_label, sym->name, num)
- != SUCCESS)
+ if (!set_binding_label (&sym->binding_label, sym->name, num))
return MATCH_ERROR;
}
- if (gfc_add_external (&sym->attr, NULL) == FAILURE)
+ if (!gfc_add_external (&sym->attr, NULL))
return MATCH_ERROR;
- if (add_hidden_procptr_result (sym) == SUCCESS)
+ if (add_hidden_procptr_result (sym))
sym = sym->result;
- if (gfc_add_proc (&sym->attr, sym->name, NULL) == FAILURE)
+ if (!gfc_add_proc (&sym->attr, sym->name, NULL))
return MATCH_ERROR;
/* Set interface. */
@@ -4954,7 +4923,7 @@ match_procedure_decl (void)
}
else if (current_ts.type != BT_UNKNOWN)
{
- if (gfc_add_type (sym, &current_ts, &gfc_current_locus) == FAILURE)
+ if (!gfc_add_type (sym, &current_ts, &gfc_current_locus))
return MATCH_ERROR;
sym->ts.interface = gfc_new_symbol ("", gfc_current_ns);
sym->ts.interface->ts = current_ts;
@@ -4977,8 +4946,7 @@ match_procedure_decl (void)
if (m != MATCH_YES)
goto cleanup;
- if (add_init_expr_to_sym (sym->name, &initializer, &gfc_current_locus)
- != SUCCESS)
+ if (!add_init_expr_to_sym (sym->name, &initializer, &gfc_current_locus))
goto cleanup;
}
@@ -5050,8 +5018,7 @@ match_ppc_decl (void)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "Procedure pointer "
- "component at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "Procedure pointer component at %C"))
return MATCH_ERROR;
/* Match PPC names. */
@@ -5064,17 +5031,17 @@ match_ppc_decl (void)
else if (m == MATCH_ERROR)
return m;
- if (gfc_add_component (gfc_current_block (), name, &c) == FAILURE)
+ if (!gfc_add_component (gfc_current_block(), name, &c))
return MATCH_ERROR;
/* Add current_attr to the symbol attributes. */
- if (gfc_copy_attr (&c->attr, &current_attr, NULL) == FAILURE)
+ if (!gfc_copy_attr (&c->attr, &current_attr, NULL))
return MATCH_ERROR;
- if (gfc_add_external (&c->attr, NULL) == FAILURE)
+ if (!gfc_add_external (&c->attr, NULL))
return MATCH_ERROR;
- if (gfc_add_proc (&c->attr, name, NULL) == FAILURE)
+ if (!gfc_add_proc (&c->attr, name, NULL))
return MATCH_ERROR;
c->tb = tb;
@@ -5143,9 +5110,8 @@ match_procedure_in_interface (void)
old_locus = gfc_current_locus;
if (gfc_match ("::") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2008, "double colon in "
- "MODULE PROCEDURE statement at %L", &old_locus)
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2008, "double colon in "
+ "MODULE PROCEDURE statement at %L", &old_locus))
return MATCH_ERROR;
}
else
@@ -5161,7 +5127,7 @@ match_procedure_in_interface (void)
if (gfc_get_symbol (name, gfc_current_ns->parent, &sym))
return MATCH_ERROR;
- if (gfc_add_interface (sym) == FAILURE)
+ if (!gfc_add_interface (sym))
return MATCH_ERROR;
if (gfc_match_eos () == MATCH_YES)
@@ -5213,8 +5179,7 @@ gfc_match_procedure (void)
if (m != MATCH_YES)
return m;
- if (gfc_notify_std (GFC_STD_F2003, "PROCEDURE statement at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "PROCEDURE statement at %C"))
return MATCH_ERROR;
return m;
@@ -5273,7 +5238,7 @@ gfc_match_function_decl (void)
if (get_proc_name (name, &sym, false))
return MATCH_ERROR;
- if (add_hidden_procptr_result (sym) == SUCCESS)
+ if (add_hidden_procptr_result (sym))
sym = sym->result;
gfc_new_block = sym;
@@ -5331,11 +5296,11 @@ gfc_match_function_decl (void)
/* Make changes to the symbol. */
m = MATCH_ERROR;
- if (gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
+ if (!gfc_add_function (&sym->attr, sym->name, NULL))
goto cleanup;
- if (gfc_missing_attr (&sym->attr, NULL) == FAILURE
- || copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
+ if (!gfc_missing_attr (&sym->attr, NULL)
+ || !copy_prefix (&sym->attr, &sym->declared_at))
goto cleanup;
/* Delay matching the function characteristics until after the
@@ -5349,15 +5314,14 @@ gfc_match_function_decl (void)
if (result == NULL)
{
if (current_ts.type != BT_UNKNOWN
- && gfc_add_type (sym, &current_ts, &gfc_current_locus) == FAILURE)
+ && !gfc_add_type (sym, &current_ts, &gfc_current_locus))
goto cleanup;
sym->result = sym;
}
else
{
if (current_ts.type != BT_UNKNOWN
- && gfc_add_type (result, &current_ts, &gfc_current_locus)
- == FAILURE)
+ && !gfc_add_type (result, &current_ts, &gfc_current_locus))
goto cleanup;
sym->result = result;
}
@@ -5424,8 +5388,7 @@ gfc_match_entry (void)
if (m != MATCH_YES)
return m;
- if (gfc_notify_std (GFC_STD_F2008_OBS,
- "ENTRY statement at %C") == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2008_OBS, "ENTRY statement at %C"))
return MATCH_ERROR;
state = gfc_current_state ();
@@ -5548,13 +5511,13 @@ gfc_match_entry (void)
gfc_error ("Missing required parentheses before BIND(C) at %C");
return MATCH_ERROR;
}
- if (gfc_add_is_bind_c (&(entry->attr), entry->name, &(entry->declared_at), 1)
- == FAILURE)
+ if (!gfc_add_is_bind_c (&(entry->attr), entry->name,
+ &(entry->declared_at), 1))
return MATCH_ERROR;
}
- if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
- || gfc_add_subroutine (&entry->attr, entry->name, NULL) == FAILURE)
+ if (!gfc_add_entry (&entry->attr, entry->name, NULL)
+ || !gfc_add_subroutine (&entry->attr, entry->name, NULL))
return MATCH_ERROR;
}
else
@@ -5589,8 +5552,8 @@ gfc_match_entry (void)
if (gfc_match_eos () == MATCH_YES)
{
- if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
- || gfc_add_function (&entry->attr, entry->name, NULL) == FAILURE)
+ if (!gfc_add_entry (&entry->attr, entry->name, NULL)
+ || !gfc_add_function (&entry->attr, entry->name, NULL))
return MATCH_ERROR;
entry->result = entry;
@@ -5605,17 +5568,16 @@ gfc_match_entry (void)
if (result)
{
- if (gfc_add_result (&result->attr, result->name, NULL) == FAILURE
- || gfc_add_entry (&entry->attr, result->name, NULL) == FAILURE
- || gfc_add_function (&entry->attr, result->name, NULL)
- == FAILURE)
+ if (!gfc_add_result (&result->attr, result->name, NULL)
+ || !gfc_add_entry (&entry->attr, result->name, NULL)
+ || !gfc_add_function (&entry->attr, result->name, NULL))
return MATCH_ERROR;
entry->result = result;
}
else
{
- if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
- || gfc_add_function (&entry->attr, entry->name, NULL) == FAILURE)
+ if (!gfc_add_entry (&entry->attr, entry->name, NULL)
+ || !gfc_add_function (&entry->attr, entry->name, NULL))
return MATCH_ERROR;
entry->result = entry;
}
@@ -5680,7 +5642,7 @@ gfc_match_subroutine (void)
the symbol existed before. */
sym->declared_at = gfc_current_locus;
- if (add_hidden_procptr_result (sym) == SUCCESS)
+ if (add_hidden_procptr_result (sym))
sym = sym->result;
gfc_new_block = sym;
@@ -5690,7 +5652,7 @@ gfc_match_subroutine (void)
gfc_gobble_whitespace ();
peek_char = gfc_peek_ascii_char ();
- if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
+ if (!gfc_add_subroutine (&sym->attr, sym->name, NULL))
return MATCH_ERROR;
if (gfc_match_formal_arglist (sym, 0, 1) != MATCH_YES)
@@ -5735,10 +5697,9 @@ gfc_match_subroutine (void)
/* The following is allowed in the Fortran 2008 draft. */
if (gfc_current_state () == COMP_CONTAINS
&& sym->ns->proc_name->attr.flavor != FL_MODULE
- && gfc_notify_std (GFC_STD_F2008, "BIND(C) attribute "
- "at %L may not be specified for an internal "
- "procedure", &gfc_current_locus)
- == FAILURE)
+ && !gfc_notify_std (GFC_STD_F2008, "BIND(C) attribute "
+ "at %L may not be specified for an internal "
+ "procedure", &gfc_current_locus))
return MATCH_ERROR;
if (peek_char != '(')
@@ -5746,8 +5707,8 @@ gfc_match_subroutine (void)
gfc_error ("Missing required parentheses before BIND(C) at %C");
return MATCH_ERROR;
}
- if (gfc_add_is_bind_c (&(sym->attr), sym->name, &(sym->declared_at), 1)
- == FAILURE)
+ if (!gfc_add_is_bind_c (&(sym->attr), sym->name,
+ &(sym->declared_at), 1))
return MATCH_ERROR;
}
@@ -5757,7 +5718,7 @@ gfc_match_subroutine (void)
return MATCH_ERROR;
}
- if (copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
+ if (!copy_prefix (&sym->attr, &sym->declared_at))
return MATCH_ERROR;
/* Warn if it has the same name as an intrinsic. */
@@ -6107,9 +6068,9 @@ gfc_match_end (gfc_statement *st)
{
if (!eos_ok && (*st == ST_END_SUBROUTINE || *st == ST_END_FUNCTION))
{
- if (gfc_notify_std (GFC_STD_F2008, "END statement "
- "instead of %s statement at %L",
- gfc_ascii_statement (*st), &old_loc) == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2008, "END statement "
+ "instead of %s statement at %L",
+ gfc_ascii_statement(*st), &old_loc))
goto cleanup;
}
else if (!eos_ok)
@@ -6246,7 +6207,7 @@ attr_decl1 (void)
if (find_special (name, &sym, false))
return MATCH_ERROR;
- if (check_function_name (name) == FAILURE)
+ if (!check_function_name (name))
{
m = MATCH_ERROR;
goto cleanup;
@@ -6306,8 +6267,7 @@ attr_decl1 (void)
to the first component, or '_data' field. */
if (sym->ts.type == BT_CLASS && sym->ts.u.derived->attr.is_class)
{
- if (gfc_copy_attr (&CLASS_DATA (sym)->attr, &current_attr, &var_locus)
- == FAILURE)
+ if (!gfc_copy_attr (&CLASS_DATA(sym)->attr, &current_attr, &var_locus))
{
m = MATCH_ERROR;
goto cleanup;
@@ -6316,7 +6276,7 @@ attr_decl1 (void)
else
{
if (current_attr.dimension == 0 && current_attr.codimension == 0
- && gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
+ && !gfc_copy_attr (&sym->attr, &current_attr, &var_locus))
{
m = MATCH_ERROR;
goto cleanup;
@@ -6324,13 +6284,13 @@ attr_decl1 (void)
}
if (sym->ts.type == BT_CLASS
- && gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false) == FAILURE)
+ && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false))
{
m = MATCH_ERROR;
goto cleanup;
}
- if (gfc_set_array_spec (sym, as, &var_locus) == FAILURE)
+ if (!gfc_set_array_spec (sym, as, &var_locus))
{
m = MATCH_ERROR;
goto cleanup;
@@ -6344,7 +6304,7 @@ attr_decl1 (void)
goto cleanup;
}
- if (gfc_add_attribute (&sym->attr, &var_locus) == FAILURE)
+ if (!gfc_add_attribute (&sym->attr, &var_locus))
{
m = MATCH_ERROR;
goto cleanup;
@@ -6352,7 +6312,7 @@ attr_decl1 (void)
if ((current_attr.external || current_attr.intrinsic)
&& sym->attr.flavor != FL_PROCEDURE
- && gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL) == FAILURE)
+ && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL))
{
m = MATCH_ERROR;
goto cleanup;
@@ -6449,7 +6409,7 @@ cray_pointer_decl (void)
return m;
}
- if (gfc_add_cray_pointer (&cptr->attr, &var_locus) == FAILURE)
+ if (!gfc_add_cray_pointer (&cptr->attr, &var_locus))
return MATCH_ERROR;
gfc_set_sym_referenced (cptr);
@@ -6502,14 +6462,14 @@ cray_pointer_decl (void)
as = NULL;
}
- if (gfc_add_cray_pointee (&cpte->attr, &var_locus) == FAILURE)
+ if (!gfc_add_cray_pointee (&cpte->attr, &var_locus))
return MATCH_ERROR;
gfc_set_sym_referenced (cpte);
if (cpte->as == NULL)
{
- if (gfc_set_array_spec (cpte, as, &var_locus) == FAILURE)
+ if (!gfc_set_array_spec (cpte, as, &var_locus))
gfc_internal_error ("Couldn't set Cray pointee array spec.");
}
else if (as != NULL)
@@ -6662,8 +6622,7 @@ gfc_match_codimension (void)
match
gfc_match_contiguous (void)
{
- if (gfc_notify_std (GFC_STD_F2008, "CONTIGUOUS statement at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2008, "CONTIGUOUS statement at %C"))
return MATCH_ERROR;
gfc_clear_attr (&current_attr);
@@ -6727,16 +6686,17 @@ access_attr_decl (gfc_statement st)
if (gfc_get_symbol (name, NULL, &sym))
goto done;
- if (gfc_add_access (&sym->attr, (st == ST_PUBLIC)
- ? ACCESS_PUBLIC : ACCESS_PRIVATE,
- sym->name, NULL) == FAILURE)
+ if (!gfc_add_access (&sym->attr,
+ (st == ST_PUBLIC)
+ ? ACCESS_PUBLIC : ACCESS_PRIVATE,
+ sym->name, NULL))
return MATCH_ERROR;
if (sym->attr.generic && (dt_sym = gfc_find_dt_in_generic (sym))
- && gfc_add_access (&dt_sym->attr,
- (st == ST_PUBLIC) ? ACCESS_PUBLIC
- : ACCESS_PRIVATE,
- sym->name, NULL) == FAILURE)
+ && !gfc_add_access (&dt_sym->attr,
+ (st == ST_PUBLIC)
+ ? ACCESS_PUBLIC : ACCESS_PRIVATE,
+ sym->name, NULL))
return MATCH_ERROR;
break;
@@ -6815,8 +6775,7 @@ gfc_match_protected (void)
}
- if (gfc_notify_std (GFC_STD_F2003, "PROTECTED statement at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "PROTECTED statement at %C"))
return MATCH_ERROR;
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
@@ -6833,8 +6792,7 @@ gfc_match_protected (void)
switch (m)
{
case MATCH_YES:
- if (gfc_add_protected (&sym->attr, sym->name, &gfc_current_locus)
- == FAILURE)
+ if (!gfc_add_protected (&sym->attr, sym->name, &gfc_current_locus))
return MATCH_ERROR;
goto next_item;
@@ -6940,7 +6898,7 @@ do_parm (void)
gfc_symbol *sym;
gfc_expr *init;
match m;
- gfc_try t;
+ bool t;
m = gfc_match_symbol (&sym, 0);
if (m == MATCH_NO)
@@ -6962,14 +6920,14 @@ do_parm (void)
return m;
if (sym->ts.type == BT_UNKNOWN
- && gfc_set_default_type (sym, 1, NULL) == FAILURE)
+ && !gfc_set_default_type (sym, 1, NULL))
{
m = MATCH_ERROR;
goto cleanup;
}
- if (gfc_check_assign_symbol (sym, NULL, init) == FAILURE
- || gfc_add_flavor (&sym->attr, FL_PARAMETER, sym->name, NULL) == FAILURE)
+ if (!gfc_check_assign_symbol (sym, NULL, init)
+ || !gfc_add_flavor (&sym->attr, FL_PARAMETER, sym->name, NULL))
{
m = MATCH_ERROR;
goto cleanup;
@@ -6983,7 +6941,7 @@ do_parm (void)
}
t = add_init_expr_to_sym (sym->name, &init, &gfc_current_locus);
- return (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
+ return (t) ? MATCH_YES : MATCH_ERROR;
cleanup:
gfc_free_expr (init);
@@ -7036,9 +6994,8 @@ gfc_match_save (void)
{
if (gfc_current_ns->seen_save)
{
- if (gfc_notify_std (GFC_STD_LEGACY, "Blanket SAVE statement at %C "
- "follows previous SAVE statement")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_LEGACY, "Blanket SAVE statement at %C "
+ "follows previous SAVE statement"))
return MATCH_ERROR;
}
@@ -7048,9 +7005,8 @@ gfc_match_save (void)
if (gfc_current_ns->save_all)
{
- if (gfc_notify_std (GFC_STD_LEGACY, "SAVE statement at %C follows "
- "blanket SAVE statement")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_LEGACY, "SAVE statement at %C follows "
+ "blanket SAVE statement"))
return MATCH_ERROR;
}
@@ -7062,8 +7018,8 @@ gfc_match_save (void)
switch (m)
{
case MATCH_YES:
- if (gfc_add_save (&sym->attr, SAVE_EXPLICIT, sym->name,
- &gfc_current_locus) == FAILURE)
+ if (!gfc_add_save (&sym->attr, SAVE_EXPLICIT, sym->name,
+ &gfc_current_locus))
return MATCH_ERROR;
goto next_item;
@@ -7113,8 +7069,7 @@ gfc_match_value (void)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "VALUE statement at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "VALUE statement at %C"))
return MATCH_ERROR;
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
@@ -7131,8 +7086,7 @@ gfc_match_value (void)
switch (m)
{
case MATCH_YES:
- if (gfc_add_value (&sym->attr, sym->name, &gfc_current_locus)
- == FAILURE)
+ if (!gfc_add_value (&sym->attr, sym->name, &gfc_current_locus))
return MATCH_ERROR;
goto next_item;
@@ -7164,8 +7118,7 @@ gfc_match_volatile (void)
gfc_symbol *sym;
match m;
- if (gfc_notify_std (GFC_STD_F2003, "VOLATILE statement at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "VOLATILE statement at %C"))
return MATCH_ERROR;
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
@@ -7192,8 +7145,7 @@ gfc_match_volatile (void)
"%C, which is use-/host-associated", sym->name);
return MATCH_ERROR;
}
- if (gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus)
- == FAILURE)
+ if (!gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus))
return MATCH_ERROR;
goto next_item;
@@ -7225,8 +7177,7 @@ gfc_match_asynchronous (void)
gfc_symbol *sym;
match m;
- if (gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS statement at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS statement at %C"))
return MATCH_ERROR;
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
@@ -7245,8 +7196,7 @@ gfc_match_asynchronous (void)
switch (m)
{
case MATCH_YES:
- if (gfc_add_asynchronous (&sym->attr, sym->name, &gfc_current_locus)
- == FAILURE)
+ if (!gfc_add_asynchronous (&sym->attr, sym->name, &gfc_current_locus))
return MATCH_ERROR;
goto next_item;
@@ -7316,9 +7266,8 @@ gfc_match_modproc (void)
old_locus = gfc_current_locus;
if (gfc_match ("::") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2008, "double colon in "
- "MODULE PROCEDURE statement at %L", &old_locus)
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2008, "double colon in "
+ "MODULE PROCEDURE statement at %L", &old_locus))
return MATCH_ERROR;
}
else
@@ -7356,11 +7305,10 @@ gfc_match_modproc (void)
}
if (sym->attr.proc != PROC_MODULE
- && gfc_add_procedure (&sym->attr, PROC_MODULE,
- sym->name, NULL) == FAILURE)
+ && !gfc_add_procedure (&sym->attr, PROC_MODULE, sym->name, NULL))
return MATCH_ERROR;
- if (gfc_add_interface (sym) == FAILURE)
+ if (!gfc_add_interface (sym))
return MATCH_ERROR;
sym->attr.mod_proc = 1;
@@ -7455,7 +7403,7 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
return MATCH_ERROR;
}
- if (gfc_add_access (attr, ACCESS_PRIVATE, NULL, NULL) == FAILURE)
+ if (!gfc_add_access (attr, ACCESS_PRIVATE, NULL, NULL))
return MATCH_ERROR;
}
else if (gfc_match (" , public") == MATCH_YES)
@@ -7467,7 +7415,7 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
return MATCH_ERROR;
}
- if (gfc_add_access (attr, ACCESS_PUBLIC, NULL, NULL) == FAILURE)
+ if (!gfc_add_access (attr, ACCESS_PUBLIC, NULL, NULL))
return MATCH_ERROR;
}
else if (gfc_match (" , bind ( c )") == MATCH_YES)
@@ -7476,23 +7424,22 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
sure that all fields are interoperable. This will
need to be a semantic check on the finished derived type.
See 15.2.3 (lines 9-12) of F2003 draft. */
- if (gfc_add_is_bind_c (attr, NULL, &gfc_current_locus, 0) != SUCCESS)
+ if (!gfc_add_is_bind_c (attr, NULL, &gfc_current_locus, 0))
return MATCH_ERROR;
/* TODO: attr conflicts need to be checked, probably in symbol.c. */
}
else if (gfc_match (" , abstract") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "ABSTRACT type at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "ABSTRACT type at %C"))
return MATCH_ERROR;
- if (gfc_add_abstract (attr, &gfc_current_locus) == FAILURE)
+ if (!gfc_add_abstract (attr, &gfc_current_locus))
return MATCH_ERROR;
}
- else if (name && gfc_match(" , extends ( %n )", name) == MATCH_YES)
+ else if (name && gfc_match (" , extends ( %n )", name) == MATCH_YES)
{
- if (gfc_add_extension (attr, &gfc_current_locus) == FAILURE)
+ if (!gfc_add_extension (attr, &gfc_current_locus))
return MATCH_ERROR;
}
else
@@ -7575,11 +7522,11 @@ gfc_match_derived_decl (void)
}
if (!gensym->attr.generic
- && gfc_add_generic (&gensym->attr, gensym->name, NULL) == FAILURE)
+ && !gfc_add_generic (&gensym->attr, gensym->name, NULL))
return MATCH_ERROR;
if (!gensym->attr.function
- && gfc_add_function (&gensym->attr, gensym->name, NULL) == FAILURE)
+ && !gfc_add_function (&gensym->attr, gensym->name, NULL))
return MATCH_ERROR;
sym = gfc_find_dt_in_generic (gensym);
@@ -7614,16 +7561,16 @@ gfc_match_derived_decl (void)
derived type that is a pointer. The first part of the AND clause
is true if the symbol is not the return value of a function. */
if (sym->attr.flavor != FL_DERIVED
- && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE)
+ && !gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL))
return MATCH_ERROR;
if (attr.access != ACCESS_UNKNOWN
- && gfc_add_access (&sym->attr, attr.access, sym->name, NULL) == FAILURE)
+ && !gfc_add_access (&sym->attr, attr.access, sym->name, NULL))
return MATCH_ERROR;
else if (sym->attr.access == ACCESS_UNKNOWN
&& gensym->attr.access != ACCESS_UNKNOWN
- && gfc_add_access (&sym->attr, gensym->attr.access, sym->name, NULL)
- == FAILURE)
+ && !gfc_add_access (&sym->attr, gensym->attr.access,
+ sym->name, NULL))
return MATCH_ERROR;
if (sym->attr.access != ACCESS_UNKNOWN
@@ -7714,8 +7661,7 @@ gfc_match_enum (void)
if (m != MATCH_YES)
return m;
- if (gfc_notify_std (GFC_STD_F2003, "ENUM and ENUMERATOR at %C")
- == FAILURE)
+ if (!gfc_notify_std (GFC_STD_F2003, "ENUM and ENUMERATOR at %C"))
return MATCH_ERROR;
return MATCH_YES;
@@ -7776,7 +7722,7 @@ enumerator_decl (void)
gfc_symbol *sym;
locus var_locus;
match m;
- gfc_try t;
+ bool t;
locus old_locus;
initializer = NULL;
@@ -7794,7 +7740,7 @@ enumerator_decl (void)
/* OK, we've successfully matched the declaration. Now put the
symbol in the current namespace. If we fail to create the symbol,
bail out. */
- if (build_sym (name, NULL, false, &as, &var_locus) == FAILURE)
+ if (!build_sym (name, NULL, false, &as, &var_locus))
{
m = MATCH_ERROR;
goto cleanup;
@@ -7842,7 +7788,7 @@ enumerator_decl (void)
gfc_find_symbol (name, NULL, 0, &sym);
create_enum_history (sym, last_initializer);
- return (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
+ return (t) ? MATCH_YES : MATCH_ERROR;
cleanup:
/* Free stuff up and return. */
@@ -7858,7 +7804,7 @@ match
gfc_match_enumerator_def (void)
{
match m;
- gfc_try t;
+ bool t;
gfc_clear_ts (&current_ts);
@@ -7884,7 +7830,7 @@ gfc_match_enumerator_def (void)
gfc_clear_attr (&current_attr);
t = gfc_add_flavor (&current_attr, FL_PARAMETER, NULL, NULL);
- if (t == FAILURE)
+ if (!t)
{
m = MATCH_ERROR;
goto cleanup;
@@ -8208,8 +8154,7 @@ match_procedure_in_type (void)
return MATCH_ERROR;
}
- if (num>1 && gfc_notify_std (GFC_STD_F2008, "PROCEDURE list"
- " at %C") == FAILURE)
+ if (num>1 && !gfc_notify_std (GFC_STD_F2008, "PROCEDURE list at %C"))
return MATCH_ERROR;
/* Try to match the '=> target', if it's there. */
@@ -8596,8 +8541,7 @@ gfc_match_final_decl (void)
/* Mark the symbol as module procedure. */
if (sym->attr.proc != PROC_MODULE
- && gfc_add_procedure (&sym->attr, PROC_MODULE,
- sym->name, NULL) == FAILURE)
+ && !gfc_add_procedure (&sym->attr, PROC_MODULE, sym->name, NULL))
return MATCH_ERROR;
/* Check if we already have this symbol in the list, this is an error. */
@@ -8677,8 +8621,7 @@ gfc_match_gcc_attributes (void)
return MATCH_ERROR;
}
- if (gfc_add_ext_attribute (&attr, (ext_attr_id_t) id, &gfc_current_locus)
- == FAILURE)
+ if (!gfc_add_ext_attribute (&attr, (ext_attr_id_t)id, &gfc_current_locus))
return MATCH_ERROR;
gfc_gobble_whitespace ();