diff options
Diffstat (limited to 'gcc/fortran/decl.c')
-rw-r--r-- | gcc/fortran/decl.c | 677 |
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, ¤t_ts)) - && gfc_add_type (sym, ¤t_ts, var_locus) == FAILURE) - return FAILURE; + && !gfc_add_type (sym, ¤t_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 (¤t_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 (¤t_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 (¤t_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 (¤t_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 (¤t_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 (¤t_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 (¤t_attr, NULL) == FAILURE) + if (!gfc_add_elemental (¤t_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 (¤t_attr, NULL) == FAILURE) + if (!gfc_add_pure (¤t_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 (¤t_attr, NULL) == FAILURE) + if (!gfc_add_recursive (¤t_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 (¤t_attr, NULL) == FAILURE) + if (!gfc_add_pure (¤t_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, ¤t_attr, NULL) == FAILURE) + if (!gfc_copy_attr (&sym->attr, ¤t_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, ¤t_ts, &gfc_current_locus) == FAILURE) + if (!gfc_add_type (sym, ¤t_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, ¤t_attr, NULL) == FAILURE) + if (!gfc_copy_attr (&c->attr, ¤t_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, ¤t_ts, &gfc_current_locus) == FAILURE) + && !gfc_add_type (sym, ¤t_ts, &gfc_current_locus)) goto cleanup; sym->result = sym; } else { if (current_ts.type != BT_UNKNOWN - && gfc_add_type (result, ¤t_ts, &gfc_current_locus) - == FAILURE) + && !gfc_add_type (result, ¤t_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, ¤t_attr, &var_locus) - == FAILURE) + if (!gfc_copy_attr (&CLASS_DATA(sym)->attr, ¤t_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, ¤t_attr, &var_locus) == FAILURE) + && !gfc_copy_attr (&sym->attr, ¤t_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 (¤t_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 (¤t_ts); @@ -7884,7 +7830,7 @@ gfc_match_enumerator_def (void) gfc_clear_attr (¤t_attr); t = gfc_add_flavor (¤t_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 (); |