diff options
36 files changed, 4849 insertions, 4989 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6a5702f..e6ec4f4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,38 @@ +2013-04-11 Janne Blomqvist <jb@gcc.gnu.org> + + * gfortran.h: Remove enum gfc_try, replace gfc_try with bool type. + * arith.c: Replace gfc_try with bool type. + * array.c: Likewise. + * check.c: Likewise. + * class.c: Likewise. + * cpp.c: Likewise. + * cpp.h: Likewise. + * data.c: Likewise. + * data.h: Likewise. + * decl.c: Likewise. + * error.c: Likewise. + * expr.c: Likewise. + * f95-lang.c: Likewise. + * interface.c: Likewise. + * intrinsic.c: Likewise. + * intrinsic.h: Likewise. + * io.c: Likewise. + * match.c: Likewise. + * match.h: Likewise. + * module.c: Likewise. + * openmp.c: Likewise. + * parse.c: Likewise. + * parse.h: Likewise. + * primary.c: Likewise. + * resolve.c: Likewise. + * scanner.c: Likewise. + * simplify.c: Likewise. + * symbol.c: Likewise. + * trans-intrinsic.c: Likewise. + * trans-openmp.c: Likewise. + * trans-stmt.c: Likewise. + * trans-types.c: Likewise. + 2013-04-09 Tobias Burnus <burnus@net-b.de> * gfortran.texi (KIND Type Parameters, diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 83a9e3c..3339585 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -901,9 +901,9 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) if (gfc_init_expr_flag) { - if (gfc_notify_std (GFC_STD_F2003, "Noninteger " - "exponent in an initialization " - "expression at %L", &op2->where) == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "Noninteger " + "exponent in an initialization " + "expression at %L", &op2->where)) { gfc_free_expr (result); return ARITH_PROHIBIT; @@ -926,9 +926,9 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) { if (gfc_init_expr_flag) { - if (gfc_notify_std (GFC_STD_F2003, "Noninteger " - "exponent in an initialization " - "expression at %L", &op2->where) == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "Noninteger " + "exponent in an initialization " + "expression at %L", &op2->where)) { gfc_free_expr (result); return ARITH_PROHIBIT; @@ -1347,8 +1347,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), gfc_expr *r; arith rc = ARITH_OK; - if (gfc_check_conformance (op1, op2, - "elemental binary operation") != SUCCESS) + if (!gfc_check_conformance (op1, op2, "elemental binary operation")) return ARITH_INCOMMENSURATE; head = gfc_constructor_copy (op1->value.constructor); diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 6ee292c..c2ac1ec 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -300,15 +300,15 @@ gfc_free_array_spec (gfc_array_spec *as) /* Take an array bound, resolves the expression, that make up the shape and check associated constraints. */ -static gfc_try +static bool resolve_array_bound (gfc_expr *e, int check_constant) { if (e == NULL) - return SUCCESS; + return true; - if (gfc_resolve_expr (e) == FAILURE - || gfc_specification_expr (e) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (e) + || !gfc_specification_expr (e)) + return false; if (check_constant && !gfc_is_constant_expr (e)) { @@ -318,34 +318,34 @@ resolve_array_bound (gfc_expr *e, int check_constant) else gfc_error ("Expression at %L in this context must be constant", &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Takes an array specification, resolves the expressions that make up the shape and make sure everything is integral. */ -gfc_try +bool gfc_resolve_array_spec (gfc_array_spec *as, int check_constant) { gfc_expr *e; int i; if (as == NULL) - return SUCCESS; + return true; for (i = 0; i < as->rank + as->corank; i++) { e = as->lower[i]; - if (resolve_array_bound (e, check_constant) == FAILURE) - return FAILURE; + if (!resolve_array_bound (e, check_constant)) + return false; e = as->upper[i]; - if (resolve_array_bound (e, check_constant) == FAILURE) - return FAILURE; + if (!resolve_array_bound (e, check_constant)) + return false; if ((as->lower[i] == NULL) || (as->upper[i] == NULL)) continue; @@ -363,7 +363,7 @@ gfc_resolve_array_spec (gfc_array_spec *as, int check_constant) } } - return SUCCESS; + return true; } @@ -412,7 +412,7 @@ match_array_element_spec (gfc_array_spec *as) gfc_error ("Expected expression in array specification at %C"); if (m != MATCH_YES) return AS_UNKNOWN; - if (gfc_expr_check_typed (*upper, gfc_current_ns, false) == FAILURE) + if (!gfc_expr_check_typed (*upper, gfc_current_ns, false)) return AS_UNKNOWN; if (gfc_match_char (':') == MATCH_NO) @@ -432,7 +432,7 @@ match_array_element_spec (gfc_array_spec *as) return AS_UNKNOWN; if (m == MATCH_NO) return AS_ASSUMED_SHAPE; - if (gfc_expr_check_typed (*upper, gfc_current_ns, false) == FAILURE) + if (!gfc_expr_check_typed (*upper, gfc_current_ns, false)) return AS_UNKNOWN; return AS_EXPLICIT; @@ -467,8 +467,7 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim) as->type = AS_ASSUMED_RANK; as->rank = -1; - if (gfc_notify_std (GFC_STD_F2008_TS, "Assumed-rank array at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008_TS, "Assumed-rank array at %C")) goto cleanup; if (!match_codim) @@ -576,9 +575,8 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim) } if (as->corank + as->rank >= 7 - && gfc_notify_std (GFC_STD_F2008, "Array " - "specification at %C with more than 7 dimensions") - == FAILURE) + && !gfc_notify_std (GFC_STD_F2008, "Array specification at %C " + "with more than 7 dimensions")) goto cleanup; } @@ -589,8 +587,7 @@ coarray: if (gfc_match_char ('[') != MATCH_YES) goto done; - if (gfc_notify_std (GFC_STD_F2008, "Coarray declaration at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "Coarray declaration at %C")) goto cleanup; if (gfc_option.coarray == GFC_FCOARRAY_NONE) @@ -730,26 +727,26 @@ cleanup: have that array specification. The error locus is needed in case something goes wrong. On failure, the caller must free the spec. */ -gfc_try +bool gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc) { int i; if (as == NULL) - return SUCCESS; + return true; if (as->rank - && gfc_add_dimension (&sym->attr, sym->name, error_loc) == FAILURE) - return FAILURE; + && !gfc_add_dimension (&sym->attr, sym->name, error_loc)) + return false; if (as->corank - && gfc_add_codimension (&sym->attr, sym->name, error_loc) == FAILURE) - return FAILURE; + && !gfc_add_codimension (&sym->attr, sym->name, error_loc)) + return false; if (sym->as == NULL) { sym->as = as; - return SUCCESS; + return true; } if ((sym->as->type == AS_ASSUMED_RANK && as->corank) @@ -757,7 +754,7 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc) { gfc_error ("The assumed-rank array '%s' at %L shall not have a " "codimension", sym->name, error_loc); - return FAILURE; + return false; } if (as->corank) @@ -799,7 +796,7 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc) } free (as); - return SUCCESS; + return true; } @@ -1060,8 +1057,8 @@ gfc_match_array_constructor (gfc_expr **result) return MATCH_NO; else { - if (gfc_notify_std (GFC_STD_F2003, "[...] " - "style array constructors at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "[...] " + "style array constructors at %C")) return MATCH_ERROR; end_delim = " ]"; } @@ -1082,8 +1079,8 @@ gfc_match_array_constructor (gfc_expr **result) if (seen_ts) { - if (gfc_notify_std (GFC_STD_F2003, "Array constructor " - "including type specification at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "Array constructor " + "including type specification at %C")) { gfc_restore_last_undo_checkpoint (); goto cleanup; @@ -1196,7 +1193,7 @@ check_element_type (gfc_expr *expr, bool convert) return 0; if (convert) - return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1; + return gfc_convert_type(expr, &constructor_ts, 1) ? 0 : 1; gfc_error ("Element in %s array constructor at %L is %s", gfc_typename (&constructor_ts), &expr->where, @@ -1209,7 +1206,7 @@ check_element_type (gfc_expr *expr, bool convert) /* Recursive work function for gfc_check_constructor_type(). */ -static gfc_try +static bool check_constructor_type (gfc_constructor_base base, bool convert) { gfc_constructor *c; @@ -1221,27 +1218,27 @@ check_constructor_type (gfc_constructor_base base, bool convert) if (e->expr_type == EXPR_ARRAY) { - if (check_constructor_type (e->value.constructor, convert) == FAILURE) - return FAILURE; + if (!check_constructor_type (e->value.constructor, convert)) + return false; continue; } if (check_element_type (e, convert)) - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Check that all elements of an array constructor are the same type. - On FAILURE, an error has been generated. */ + On false, an error has been generated. */ -gfc_try +bool gfc_check_constructor_type (gfc_expr *e) { - gfc_try t; + bool t; if (e->ts.type != BT_UNKNOWN) { @@ -1257,7 +1254,7 @@ gfc_check_constructor_type (gfc_expr *e) /* If e->ts.type != BT_UNKNOWN, the array constructor included a typespec, and we will now convert the values on the fly. */ t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN); - if (t == SUCCESS && e->ts.type == BT_UNKNOWN) + if (t && e->ts.type == BT_UNKNOWN) e->ts = constructor_ts; return t; @@ -1274,12 +1271,12 @@ cons_stack; static cons_stack *base; -static gfc_try check_constructor (gfc_constructor_base, gfc_try (*) (gfc_expr *)); +static bool check_constructor (gfc_constructor_base, bool (*) (gfc_expr *)); /* Check an EXPR_VARIABLE expression in a constructor to make sure that that variable is an iteration variables. */ -gfc_try +bool gfc_check_iter_variable (gfc_expr *expr) { gfc_symbol *sym; @@ -1289,9 +1286,9 @@ gfc_check_iter_variable (gfc_expr *expr) for (c = base; c && c->iterator; c = c->previous) if (sym == c->iterator->var->symtree->n.sym) - return SUCCESS; + return true; - return FAILURE; + return false; } @@ -1299,12 +1296,12 @@ gfc_check_iter_variable (gfc_expr *expr) to calling the check function for each expression in the constructor, giving variables with the names of iterators a pass. */ -static gfc_try -check_constructor (gfc_constructor_base ctor, gfc_try (*check_function) (gfc_expr *)) +static bool +check_constructor (gfc_constructor_base ctor, bool (*check_function) (gfc_expr *)) { cons_stack element; gfc_expr *e; - gfc_try t; + bool t; gfc_constructor *c; for (c = gfc_constructor_first (ctor); c; c = gfc_constructor_next (c)) @@ -1313,8 +1310,8 @@ check_constructor (gfc_constructor_base ctor, gfc_try (*check_function) (gfc_exp if (e->expr_type != EXPR_ARRAY) { - if ((*check_function) (e) == FAILURE) - return FAILURE; + if (!(*check_function)(e)) + return false; continue; } @@ -1325,12 +1322,12 @@ check_constructor (gfc_constructor_base ctor, gfc_try (*check_function) (gfc_exp t = check_constructor (e->value.constructor, check_function); base = element.previous; - if (t == FAILURE) - return FAILURE; + if (!t) + return false; } /* Nothing went wrong, so all OK. */ - return SUCCESS; + return true; } @@ -1338,11 +1335,11 @@ check_constructor (gfc_constructor_base ctor, gfc_try (*check_function) (gfc_exp expression -- specification, restricted, or initialization as determined by the check_function. */ -gfc_try -gfc_check_constructor (gfc_expr *expr, gfc_try (*check_function) (gfc_expr *)) +bool +gfc_check_constructor (gfc_expr *expr, bool (*check_function) (gfc_expr *)) { cons_stack *base_save; - gfc_try t; + bool t; base_save = base; base = NULL; @@ -1370,19 +1367,19 @@ typedef struct gfc_component *component; mpz_t *repeat; - gfc_try (*expand_work_function) (gfc_expr *); + bool (*expand_work_function) (gfc_expr *); } expand_info; static expand_info current_expand; -static gfc_try expand_constructor (gfc_constructor_base); +static bool expand_constructor (gfc_constructor_base); /* Work function that counts the number of elements present in a constructor. */ -static gfc_try +static bool count_elements (gfc_expr *e) { mpz_t result; @@ -1391,10 +1388,10 @@ count_elements (gfc_expr *e) mpz_add_ui (*current_expand.count, *current_expand.count, 1); else { - if (gfc_array_size (e, &result) == FAILURE) + if (!gfc_array_size (e, &result)) { gfc_free_expr (e); - return FAILURE; + return false; } mpz_add (*current_expand.count, *current_expand.count, result); @@ -1402,20 +1399,20 @@ count_elements (gfc_expr *e) } gfc_free_expr (e); - return SUCCESS; + return true; } /* Work function that extracts a particular element from an array constructor, freeing the rest. */ -static gfc_try +static bool extract_element (gfc_expr *e) { if (e->rank != 0) { /* Something unextractable */ gfc_free_expr (e); - return FAILURE; + return false; } if (current_expand.extract_count == current_expand.extract_n) @@ -1425,21 +1422,21 @@ extract_element (gfc_expr *e) current_expand.extract_count++; - return SUCCESS; + return true; } /* Work function that constructs a new constructor out of the old one, stringing new elements together. */ -static gfc_try +static bool expand (gfc_expr *e) { gfc_constructor *c = gfc_constructor_append_expr (¤t_expand.base, e, &e->where); c->n.component = current_expand.component; - return SUCCESS; + return true; } @@ -1469,7 +1466,7 @@ gfc_simplify_iterator_var (gfc_expr *e) /* Expand an expression with that is inside of a constructor, recursing into other constructors if present. */ -static gfc_try +static bool expand_expr (gfc_expr *e) { if (e->expr_type == EXPR_ARRAY) @@ -1477,48 +1474,48 @@ expand_expr (gfc_expr *e) e = gfc_copy_expr (e); - if (gfc_simplify_expr (e, 1) == FAILURE) + if (!gfc_simplify_expr (e, 1)) { gfc_free_expr (e); - return FAILURE; + return false; } return current_expand.expand_work_function (e); } -static gfc_try +static bool expand_iterator (gfc_constructor *c) { gfc_expr *start, *end, *step; iterator_stack frame; mpz_t trip; - gfc_try t; + bool t; end = step = NULL; - t = FAILURE; + t = false; mpz_init (trip); mpz_init (frame.value); frame.prev = NULL; start = gfc_copy_expr (c->iterator->start); - if (gfc_simplify_expr (start, 1) == FAILURE) + if (!gfc_simplify_expr (start, 1)) goto cleanup; if (start->expr_type != EXPR_CONSTANT || start->ts.type != BT_INTEGER) goto cleanup; end = gfc_copy_expr (c->iterator->end); - if (gfc_simplify_expr (end, 1) == FAILURE) + if (!gfc_simplify_expr (end, 1)) goto cleanup; if (end->expr_type != EXPR_CONSTANT || end->ts.type != BT_INTEGER) goto cleanup; step = gfc_copy_expr (c->iterator->step); - if (gfc_simplify_expr (step, 1) == FAILURE) + if (!gfc_simplify_expr (step, 1)) goto cleanup; if (step->expr_type != EXPR_CONSTANT || step->ts.type != BT_INTEGER) @@ -1543,14 +1540,14 @@ expand_iterator (gfc_constructor *c) while (mpz_sgn (trip) > 0) { - if (expand_expr (c->expr) == FAILURE) + if (!expand_expr (c->expr)) goto cleanup; mpz_add (frame.value, frame.value, step->value.integer); mpz_sub_ui (trip, trip, 1); } - t = SUCCESS; + t = true; cleanup: gfc_free_expr (start); @@ -1571,7 +1568,7 @@ cleanup: expressions. The work function needs to either save or free the passed expression. */ -static gfc_try +static bool expand_constructor (gfc_constructor_base base) { gfc_constructor *c; @@ -1581,8 +1578,8 @@ expand_constructor (gfc_constructor_base base) { if (c->iterator != NULL) { - if (expand_iterator (c) == FAILURE) - return FAILURE; + if (!expand_iterator (c)) + return false; continue; } @@ -1590,25 +1587,25 @@ expand_constructor (gfc_constructor_base base) if (e->expr_type == EXPR_ARRAY) { - if (expand_constructor (e->value.constructor) == FAILURE) - return FAILURE; + if (!expand_constructor (e->value.constructor)) + return false; continue; } e = gfc_copy_expr (e); - if (gfc_simplify_expr (e, 1) == FAILURE) + if (!gfc_simplify_expr (e, 1)) { gfc_free_expr (e); - return FAILURE; + return false; } current_expand.offset = &c->offset; current_expand.repeat = &c->repeat; current_expand.component = c->n.component; - if (current_expand.expand_work_function (e) == FAILURE) - return FAILURE; + if (!current_expand.expand_work_function(e)) + return false; } - return SUCCESS; + return true; } @@ -1624,7 +1621,7 @@ gfc_get_array_element (gfc_expr *array, int element) { expand_info expand_save; gfc_expr *e; - gfc_try rc; + bool rc; expand_save = current_expand; current_expand.extract_n = element; @@ -1638,7 +1635,7 @@ gfc_get_array_element (gfc_expr *array, int element) e = current_expand.extracted; current_expand = expand_save; - if (rc == FAILURE) + if (!rc) return NULL; return e; @@ -1648,12 +1645,12 @@ gfc_get_array_element (gfc_expr *array, int element) /* Top level subroutine for expanding constructors. We only expand constructor if they are small enough. */ -gfc_try +bool gfc_expand_constructor (gfc_expr *e, bool fatal) { expand_info expand_save; gfc_expr *f; - gfc_try rc; + bool rc; /* If we can successfully get an array element at the max array size then the array is too big to expand, so we just return. */ @@ -1668,9 +1665,9 @@ gfc_expand_constructor (gfc_expr *e, bool fatal) "upper limit. See -fmax-array-constructor " "option", &e->where, gfc_option.flag_max_array_constructor); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* We now know the array is not too big so go ahead and try to expand it. */ @@ -1681,17 +1678,17 @@ gfc_expand_constructor (gfc_expr *e, bool fatal) current_expand.expand_work_function = expand; - if (expand_constructor (e->value.constructor) == FAILURE) + if (!expand_constructor (e->value.constructor)) { gfc_constructor_free (current_expand.base); - rc = FAILURE; + rc = false; goto done; } gfc_constructor_free (e->value.constructor); e->value.constructor = current_expand.base; - rc = SUCCESS; + rc = true; done: current_expand = expand_save; @@ -1702,9 +1699,9 @@ done: /* Work function for checking that an element of a constructor is a constant, after removal of any iteration variables. We return - FAILURE if not so. */ + false if not so. */ -static gfc_try +static bool is_constant_element (gfc_expr *e) { int rv; @@ -1712,7 +1709,7 @@ is_constant_element (gfc_expr *e) rv = gfc_is_constant_expr (e); gfc_free_expr (e); - return rv ? SUCCESS : FAILURE; + return rv ? true : false; } @@ -1726,7 +1723,7 @@ int gfc_constant_ac (gfc_expr *e) { expand_info expand_save; - gfc_try rc; + bool rc; iter_stack = NULL; expand_save = current_expand; @@ -1735,7 +1732,7 @@ gfc_constant_ac (gfc_expr *e) rc = expand_constructor (e->value.constructor); current_expand = expand_save; - if (rc == FAILURE) + if (!rc) return 0; return 1; @@ -1809,14 +1806,14 @@ find_symbol_in_expr (gfc_symbol *sym, gfc_expr *expr, locus *sym_loc) /* Recursive array list resolution function. All of the elements must be of the same type. */ -static gfc_try +static bool resolve_array_list (gfc_constructor_base base) { - gfc_try t; + bool t; gfc_constructor *c; gfc_iterator *iter; - t = SUCCESS; + t = true; for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c)) { @@ -1826,43 +1823,43 @@ resolve_array_list (gfc_constructor_base base) gfc_symbol *iter_var; locus iter_var_loc; - if (gfc_resolve_iterator (iter, false, true) == FAILURE) - t = FAILURE; + if (!gfc_resolve_iterator (iter, false, true)) + t = false; /* Check for bounds referencing the iterator variable. */ gcc_assert (iter->var->expr_type == EXPR_VARIABLE); iter_var = iter->var->symtree->n.sym; if (find_symbol_in_expr (iter_var, iter->start, &iter_var_loc)) { - if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO initial " - "expression references control variable " - "at %L", &iter_var_loc) == FAILURE) - t = FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO initial " + "expression references control variable " + "at %L", &iter_var_loc)) + t = false; } if (find_symbol_in_expr (iter_var, iter->end, &iter_var_loc)) { - if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO final " - "expression references control variable " - "at %L", &iter_var_loc) == FAILURE) - t = FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO final " + "expression references control variable " + "at %L", &iter_var_loc)) + t = false; } if (find_symbol_in_expr (iter_var, iter->step, &iter_var_loc)) { - if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO step " - "expression references control variable " - "at %L", &iter_var_loc) == FAILURE) - t = FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO step " + "expression references control variable " + "at %L", &iter_var_loc)) + t = false; } } - if (gfc_resolve_expr (c->expr) == FAILURE) - t = FAILURE; + if (!gfc_resolve_expr (c->expr)) + t = false; if (UNLIMITED_POLY (c->expr)) { gfc_error ("Array constructor value at %L shall not be unlimited " "polymorphic [F2008: C4106]", &c->expr->where); - t = FAILURE; + t = false; } } @@ -1874,7 +1871,7 @@ resolve_array_list (gfc_constructor_base base) all elements are of compile-time known length, emit an error as this is invalid. */ -gfc_try +bool gfc_resolve_character_array_constructor (gfc_expr *expr) { gfc_constructor *p; @@ -1935,7 +1932,7 @@ got_charlen: current_length = (int) j; } else - return SUCCESS; + return true; gcc_assert (current_length != -1); @@ -1946,7 +1943,7 @@ got_charlen: gfc_error ("Different CHARACTER lengths (%d/%d) in array" " constructor at %L", found_length, current_length, &p->expr->where); - return FAILURE; + return false; } gcc_assert (found_length == current_length); @@ -2000,19 +1997,19 @@ got_charlen: } } - return SUCCESS; + return true; } /* Resolve all of the expressions in an array list. */ -gfc_try +bool gfc_resolve_array_constructor (gfc_expr *expr) { - gfc_try t; + bool t; t = resolve_array_list (expr->value.constructor); - if (t == SUCCESS) + if (t) t = gfc_check_constructor_type (expr); /* gfc_resolve_character_array_constructor is called in gfc_resolve_expr after @@ -2054,11 +2051,11 @@ gfc_copy_iterator (gfc_iterator *src) /* Get the size of single dimension of an array specification. The array is guaranteed to be one dimensional. */ -gfc_try +bool spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result) { if (as == NULL) - return FAILURE; + return false; if (dimen < 0 || dimen > as->rank - 1) gfc_internal_error ("spec_dimen_size(): Bad dimension"); @@ -2068,7 +2065,7 @@ spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result) || as->upper[dimen]->expr_type != EXPR_CONSTANT || as->lower[dimen]->ts.type != BT_INTEGER || as->upper[dimen]->ts.type != BT_INTEGER) - return FAILURE; + return false; mpz_init (*result); @@ -2077,45 +2074,45 @@ spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result) mpz_add_ui (*result, *result, 1); - return SUCCESS; + return true; } -gfc_try +bool spec_size (gfc_array_spec *as, mpz_t *result) { mpz_t size; int d; if (as->type == AS_ASSUMED_RANK) - return FAILURE; + return false; mpz_init_set_ui (*result, 1); for (d = 0; d < as->rank; d++) { - if (spec_dimen_size (as, d, &size) == FAILURE) + if (!spec_dimen_size (as, d, &size)) { mpz_clear (*result); - return FAILURE; + return false; } mpz_mul (*result, *result, size); mpz_clear (size); } - return SUCCESS; + return true; } /* Get the number of elements in an array section. Optionally, also supply the end value. */ -gfc_try +bool gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end) { mpz_t upper, lower, stride; - gfc_try t; + bool t; if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1) gfc_internal_error ("gfc_ref_dimen_size(): Bad dimension"); @@ -2125,7 +2122,7 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end) case DIMEN_ELEMENT: mpz_init (*result); mpz_set_ui (*result, 1); - t = SUCCESS; + t = true; break; case DIMEN_VECTOR: @@ -2136,7 +2133,7 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end) mpz_init (upper); mpz_init (lower); mpz_init (stride); - t = FAILURE; + t = false; if (ar->start[dimen] == NULL) { @@ -2183,7 +2180,7 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end) /* Zero stride caught earlier. */ if (mpz_cmp_ui (*result, 0) < 0) mpz_set_ui (*result, 0); - t = SUCCESS; + t = true; if (end) { @@ -2208,7 +2205,7 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end) } -static gfc_try +static bool ref_size (gfc_array_ref *ar, mpz_t *result) { mpz_t size; @@ -2218,26 +2215,26 @@ ref_size (gfc_array_ref *ar, mpz_t *result) for (d = 0; d < ar->dimen; d++) { - if (gfc_ref_dimen_size (ar, d, &size, NULL) == FAILURE) + if (!gfc_ref_dimen_size (ar, d, &size, NULL)) { mpz_clear (*result); - return FAILURE; + return false; } mpz_mul (*result, *result, size); mpz_clear (size); } - return SUCCESS; + return true; } /* Given an array expression and a dimension, figure out how many - elements it has along that dimension. Returns SUCCESS if we were - able to return a result in the 'result' variable, FAILURE + elements it has along that dimension. Returns true if we were + able to return a result in the 'result' variable, false otherwise. */ -gfc_try +bool gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) { gfc_ref *ref; @@ -2246,10 +2243,10 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) gcc_assert (array != NULL); if (array->ts.type == BT_CLASS) - return FAILURE; + return false; if (array->rank == -1) - return FAILURE; + return false; if (dimen < 0 || dimen > array->rank - 1) gfc_internal_error ("gfc_array_dimen_size(): Bad dimension"); @@ -2279,19 +2276,17 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) if (array->shape && array->shape[dimen]) { mpz_init_set (*result, array->shape[dimen]); - return SUCCESS; + return true; } if (array->symtree->n.sym->attr.generic && array->value.function.esym != NULL) { - if (spec_dimen_size (array->value.function.esym->as, dimen, result) - == FAILURE) - return FAILURE; + if (!spec_dimen_size (array->value.function.esym->as, dimen, result)) + return false; } - else if (spec_dimen_size (array->symtree->n.sym->as, dimen, result) - == FAILURE) - return FAILURE; + else if (!spec_dimen_size (array->symtree->n.sym->as, dimen, result)) + return false; break; @@ -2306,31 +2301,31 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) /* Fall through */ default: if (array->shape == NULL) - return FAILURE; + return false; mpz_init_set (*result, array->shape[dimen]); break; } - return SUCCESS; + return true; } /* Given an array expression, figure out how many elements are in the - array. Returns SUCCESS if this is possible, and sets the 'result' - variable. Otherwise returns FAILURE. */ + array. Returns true if this is possible, and sets the 'result' + variable. Otherwise returns false. */ -gfc_try +bool gfc_array_size (gfc_expr *array, mpz_t *result) { expand_info expand_save; gfc_ref *ref; int i; - gfc_try t; + bool t; if (array->ts.type == BT_CLASS) - return FAILURE; + return false; switch (array->expr_type) { @@ -2349,7 +2344,7 @@ gfc_array_size (gfc_expr *array, mpz_t *result) gfc_pop_suppress_errors (); - if (t == FAILURE) + if (!t) mpz_clear (*result); current_expand = expand_save; return t; @@ -2372,7 +2367,7 @@ gfc_array_size (gfc_expr *array, mpz_t *result) default: if (array->rank == 0 || array->shape == NULL) - return FAILURE; + return false; mpz_init_set_ui (*result, 1); @@ -2382,14 +2377,14 @@ gfc_array_size (gfc_expr *array, mpz_t *result) break; } - return SUCCESS; + return true; } /* Given an array reference, return the shape of the reference in an array of mpz_t integers. */ -gfc_try +bool gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape) { int d; @@ -2401,23 +2396,23 @@ gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape) { case AR_FULL: for (; d < ar->as->rank; d++) - if (spec_dimen_size (ar->as, d, &shape[d]) == FAILURE) + if (!spec_dimen_size (ar->as, d, &shape[d])) goto cleanup; - return SUCCESS; + return true; case AR_SECTION: for (i = 0; i < ar->dimen; i++) { if (ar->dimen_type[i] != DIMEN_ELEMENT) { - if (gfc_ref_dimen_size (ar, i, &shape[d], NULL) == FAILURE) + if (!gfc_ref_dimen_size (ar, i, &shape[d], NULL)) goto cleanup; d++; } } - return SUCCESS; + return true; default: break; @@ -2425,7 +2420,7 @@ gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape) cleanup: gfc_clear_shape (shape, d); - return FAILURE; + return false; } diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 5df5d2f..870ca75 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -37,67 +37,66 @@ along with GCC; see the file COPYING3. If not see /* Make sure an expression is a scalar. */ -static gfc_try +static bool scalar_check (gfc_expr *e, int n) { if (e->rank == 0) - return SUCCESS; + return true; gfc_error ("'%s' argument of '%s' intrinsic at %L must be a scalar", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } /* Check the type of an expression. */ -static gfc_try +static bool type_check (gfc_expr *e, int n, bt type) { if (e->ts.type == type) - return SUCCESS; + return true; gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where, gfc_basic_typename (type)); - return FAILURE; + return false; } /* Check that the expression is a numeric type. */ -static gfc_try +static bool numeric_check (gfc_expr *e, int n) { if (gfc_numeric_ts (&e->ts)) - return SUCCESS; + return true; /* If the expression has not got a type, check if its namespace can offer a default type. */ if ((e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION) && e->symtree->n.sym->ts.type == BT_UNKNOWN - && gfc_set_default_type (e->symtree->n.sym, 0, - e->symtree->n.sym->ns) == SUCCESS + && gfc_set_default_type (e->symtree->n.sym, 0, e->symtree->n.sym->ns) && gfc_numeric_ts (&e->symtree->n.sym->ts)) { e->ts = e->symtree->n.sym->ts; - return SUCCESS; + return true; } gfc_error ("'%s' argument of '%s' intrinsic at %L must be a numeric type", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } /* Check that an expression is integer or real. */ -static gfc_try +static bool int_or_real_check (gfc_expr *e, int n) { if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL) @@ -105,16 +104,16 @@ int_or_real_check (gfc_expr *e, int n) gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER " "or REAL", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Check that an expression is real or complex. */ -static gfc_try +static bool real_or_complex_check (gfc_expr *e, int n) { if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX) @@ -122,16 +121,16 @@ real_or_complex_check (gfc_expr *e, int n) gfc_error ("'%s' argument of '%s' intrinsic at %L must be REAL " "or COMPLEX", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Check that an expression is INTEGER or PROCEDURE. */ -static gfc_try +static bool int_or_proc_check (gfc_expr *e, int n) { if (e->ts.type != BT_INTEGER && e->ts.type != BT_PROCEDURE) @@ -139,36 +138,36 @@ int_or_proc_check (gfc_expr *e, int n) gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER " "or PROCEDURE", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Check that the expression is an optional constant integer and that it specifies a valid kind for that type. */ -static gfc_try +static bool kind_check (gfc_expr *k, int n, bt type) { int kind; if (k == NULL) - return SUCCESS; + return true; - if (type_check (k, n, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (k, n, BT_INTEGER)) + return false; - if (scalar_check (k, n) == FAILURE) - return FAILURE; + if (!scalar_check (k, n)) + return false; - if (gfc_check_init_expr (k) != SUCCESS) + if (!gfc_check_init_expr (k)) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &k->where); - return FAILURE; + return false; } if (gfc_extract_int (k, &kind) != NULL @@ -176,34 +175,34 @@ kind_check (gfc_expr *k, int n, bt type) { gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type), &k->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Make sure the expression is a double precision real. */ -static gfc_try +static bool double_check (gfc_expr *d, int n) { - if (type_check (d, n, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (d, n, BT_REAL)) + return false; if (d->ts.kind != gfc_default_double_kind) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be double " "precision", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &d->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -static gfc_try +static bool coarray_check (gfc_expr *e, int n) { if (e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok @@ -211,7 +210,7 @@ coarray_check (gfc_expr *e, int n) && CLASS_DATA (e)->as->corank) { gfc_add_class_array_ref (e); - return SUCCESS; + return true; } if (!gfc_is_coarray (e)) @@ -219,16 +218,16 @@ coarray_check (gfc_expr *e, int n) gfc_error ("Expected coarray variable as '%s' argument to the %s " "intrinsic at %L", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Make sure the expression is a logical array. */ -static gfc_try +static bool logical_array_check (gfc_expr *array, int n) { if (array->ts.type != BT_LOGICAL || array->rank == 0) @@ -236,16 +235,16 @@ logical_array_check (gfc_expr *array, int n) gfc_error ("'%s' argument of '%s' intrinsic at %L must be a logical " "array", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &array->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Make sure an expression is an array. */ -static gfc_try +static bool array_check (gfc_expr *e, int n) { if (e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok @@ -253,24 +252,24 @@ array_check (gfc_expr *e, int n) && CLASS_DATA (e)->as->rank) { gfc_add_class_array_ref (e); - return SUCCESS; + return true; } if (e->rank != 0 && e->ts.type != BT_PROCEDURE) - return SUCCESS; + return true; gfc_error ("'%s' argument of '%s' intrinsic at %L must be an array", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } /* If expr is a constant, then check to ensure that it is greater than of equal to zero. */ -static gfc_try +static bool nonnegative_check (const char *arg, gfc_expr *expr) { int i; @@ -281,18 +280,18 @@ nonnegative_check (const char *arg, gfc_expr *expr) if (i < 0) { gfc_error ("'%s' at %L must be nonnegative", arg, &expr->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } /* If expr2 is constant, then check that the value is less than (less than or equal to, if 'or_equal' is true) bit_size(expr1). */ -static gfc_try +static bool less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2, gfc_expr *expr2, bool or_equal) { @@ -314,7 +313,7 @@ less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2, gfc_error ("The absolute value of SHIFT at %L must be less " "than or equal to BIT_SIZE('%s')", &expr2->where, arg1); - return FAILURE; + return false; } } @@ -325,7 +324,7 @@ less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2, gfc_error ("'%s' at %L must be less than " "or equal to BIT_SIZE('%s')", arg2, &expr2->where, arg1); - return FAILURE; + return false; } } else @@ -334,25 +333,25 @@ less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2, { gfc_error ("'%s' at %L must be less than BIT_SIZE('%s')", arg2, &expr2->where, arg1); - return FAILURE; + return false; } } } - return SUCCESS; + return true; } /* If expr is constant, then check that the value is less than or equal to the bit_size of the kind k. */ -static gfc_try +static bool less_than_bitsizekind (const char *arg, gfc_expr *expr, int k) { int i, val; if (expr->expr_type != EXPR_CONSTANT) - return SUCCESS; + return true; i = gfc_validate_kind (BT_INTEGER, k, false); gfc_extract_int (expr, &val); @@ -361,17 +360,17 @@ less_than_bitsizekind (const char *arg, gfc_expr *expr, int k) { gfc_error ("'%s' at %L must be less than or equal to the BIT_SIZE of " "INTEGER(KIND=%d)", arg, &expr->where, k); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* If expr2 and expr3 are constants, then check that the value is less than or equal to bit_size(expr1). */ -static gfc_try +static bool less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2, gfc_expr *expr2, const char *arg3, gfc_expr *expr3) { @@ -388,49 +387,49 @@ less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2, gfc_error ("'%s + %s' at %L must be less than or equal " "to BIT_SIZE('%s')", arg2, arg3, &expr2->where, arg1); - return FAILURE; + return false; } } - return SUCCESS; + return true; } /* Make sure two expressions have the same type. */ -static gfc_try +static bool same_type_check (gfc_expr *e, int n, gfc_expr *f, int m) { if (gfc_compare_types (&e->ts, &f->ts)) - return SUCCESS; + return true; gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same type " "and kind as '%s'", gfc_current_intrinsic_arg[m]->name, gfc_current_intrinsic, &f->where, gfc_current_intrinsic_arg[n]->name); - return FAILURE; + return false; } /* Make sure that an expression has a certain (nonzero) rank. */ -static gfc_try +static bool rank_check (gfc_expr *e, int n, int rank) { if (e->rank == rank) - return SUCCESS; + return true; gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank %d", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where, rank); - return FAILURE; + return false; } /* Make sure a variable expression is not an optional dummy argument. */ -static gfc_try +static bool nonoptional_check (gfc_expr *e, int n) { if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional) @@ -442,13 +441,13 @@ nonoptional_check (gfc_expr *e, int n) /* TODO: Recursive check on nonoptional variables? */ - return SUCCESS; + return true; } /* Check for ALLOCATABLE attribute. */ -static gfc_try +static bool allocatable_check (gfc_expr *e, int n) { symbol_attribute attr; @@ -459,32 +458,32 @@ allocatable_check (gfc_expr *e, int n) gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Check that an expression has a particular kind. */ -static gfc_try +static bool kind_value_check (gfc_expr *e, int n, int k) { if (e->ts.kind == k) - return SUCCESS; + return true; gfc_error ("'%s' argument of '%s' intrinsic at %L must be of kind %d", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where, k); - return FAILURE; + return false; } /* Make sure an expression is a variable. */ -static gfc_try +static bool variable_check (gfc_expr *e, int n, bool allow_proc) { if (e->expr_type == EXPR_VARIABLE @@ -515,14 +514,14 @@ variable_check (gfc_expr *e, int n, bool allow_proc) gfc_error ("'%s' argument of '%s' intrinsic at %L cannot be " "INTENT(IN)", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } } if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.flavor != FL_PARAMETER && (allow_proc || !e->symtree->n.sym->attr.function)) - return SUCCESS; + return true; if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.function && e->symtree->n.sym == e->symtree->n.sym->result) @@ -530,41 +529,41 @@ variable_check (gfc_expr *e, int n, bool allow_proc) gfc_namespace *ns; for (ns = gfc_current_ns; ns; ns = ns->parent) if (ns->proc_name == e->symtree->n.sym) - return SUCCESS; + return true; } gfc_error ("'%s' argument of '%s' intrinsic at %L must be a variable", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); - return FAILURE; + return false; } /* Check the common DIM parameter for correctness. */ -static gfc_try +static bool dim_check (gfc_expr *dim, int n, bool optional) { if (dim == NULL) - return SUCCESS; + return true; - if (type_check (dim, n, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (dim, n, BT_INTEGER)) + return false; - if (scalar_check (dim, n) == FAILURE) - return FAILURE; + if (!scalar_check (dim, n)) + return false; - if (!optional && nonoptional_check (dim, n) == FAILURE) - return FAILURE; + if (!optional && !nonoptional_check (dim, n)) + return false; - return SUCCESS; + return true; } /* If a coarray DIM parameter is a constant, make sure that it is greater than zero and less than or equal to the corank of the given array. */ -static gfc_try +static bool dim_corank_check (gfc_expr *dim, gfc_expr *array) { int corank; @@ -572,10 +571,10 @@ dim_corank_check (gfc_expr *dim, gfc_expr *array) gcc_assert (array->expr_type == EXPR_VARIABLE); if (dim->expr_type != EXPR_CONSTANT) - return SUCCESS; + return true; if (array->ts.type == BT_CLASS) - return SUCCESS; + return true; corank = gfc_get_corank (array); @@ -585,10 +584,10 @@ dim_corank_check (gfc_expr *dim, gfc_expr *array) gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid " "codimension index", gfc_current_intrinsic, &dim->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -597,20 +596,20 @@ dim_corank_check (gfc_expr *dim, gfc_expr *array) allow_assumed is zero then dim must be less than the rank of the array for assumed size arrays. */ -static gfc_try +static bool dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed) { gfc_array_ref *ar; int rank; if (dim == NULL) - return SUCCESS; + return true; if (dim->expr_type != EXPR_CONSTANT) - return SUCCESS; + return true; if (array->ts.type == BT_CLASS) - return SUCCESS; + return true; if (array->expr_type == EXPR_FUNCTION && array->value.function.isym && array->value.function.isym->id == GFC_ISYM_SPREAD) @@ -638,10 +637,10 @@ dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed) gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid " "dimension index", gfc_current_intrinsic, &dim->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -660,9 +659,9 @@ identical_dimen_shape (gfc_expr *a, int ai, gfc_expr *b, int bi) ret = 1; - if (gfc_array_dimen_size (a, ai, &a_size) == SUCCESS) + if (gfc_array_dimen_size (a, ai, &a_size)) { - if (gfc_array_dimen_size (b, bi, &b_size) == SUCCESS) + if (gfc_array_dimen_size (b, bi, &b_size)) { if (mpz_cmp (a_size, b_size) != 0) ret = 0; @@ -723,10 +722,10 @@ gfc_var_strlen (const gfc_expr *a) } /* Check whether two character expressions have the same length; - returns SUCCESS if they have or if the length cannot be determined, - otherwise return FAILURE and raise a gfc_error. */ + returns true if they have or if the length cannot be determined, + otherwise return false and raise a gfc_error. */ -gfc_try +bool gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name) { long len_a, len_b; @@ -735,12 +734,12 @@ gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name) len_b = gfc_var_strlen(b); if (len_a == -1 || len_b == -1 || len_a == len_b) - return SUCCESS; + return true; else { gfc_error ("Unequal character lengths (%ld/%ld) in %s at %L", len_a, len_b, name, &a->where); - return FAILURE; + return false; } } @@ -750,21 +749,21 @@ gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name) /* Check subroutine suitable for intrinsics taking a real argument and a kind argument for the result. */ -static gfc_try +static bool check_a_kind (gfc_expr *a, gfc_expr *kind, bt type) { - if (type_check (a, 0, BT_REAL) == FAILURE) - return FAILURE; - if (kind_check (kind, 1, type) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_REAL)) + return false; + if (!kind_check (kind, 1, type)) + return false; - return SUCCESS; + return true; } /* Check subroutine suitable for ceiling, floor and nint. */ -gfc_try +bool gfc_check_a_ikind (gfc_expr *a, gfc_expr *kind) { return check_a_kind (a, kind, BT_INTEGER); @@ -773,90 +772,90 @@ gfc_check_a_ikind (gfc_expr *a, gfc_expr *kind) /* Check subroutine suitable for aint, anint. */ -gfc_try +bool gfc_check_a_xkind (gfc_expr *a, gfc_expr *kind) { return check_a_kind (a, kind, BT_REAL); } -gfc_try +bool gfc_check_abs (gfc_expr *a) { - if (numeric_check (a, 0) == FAILURE) - return FAILURE; + if (!numeric_check (a, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_achar (gfc_expr *a, gfc_expr *kind) { - if (type_check (a, 0, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind_check (kind, 1, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_INTEGER)) + return false; + if (!kind_check (kind, 1, BT_CHARACTER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_access_func (gfc_expr *name, gfc_expr *mode) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE - || scalar_check (name, 0) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER) + || !scalar_check (name, 0)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; - if (type_check (mode, 1, BT_CHARACTER) == FAILURE - || scalar_check (mode, 1) == FAILURE) - return FAILURE; - if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (mode, 1, BT_CHARACTER) + || !scalar_check (mode, 1)) + return false; + if (!kind_value_check (mode, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) { - if (logical_array_check (mask, 0) == FAILURE) - return FAILURE; + if (!logical_array_check (mask, 0)) + return false; - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (dim, 1, false)) + return false; - if (dim_rank_check (dim, mask, 0) == FAILURE) - return FAILURE; + if (!dim_rank_check (dim, mask, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_allocated (gfc_expr *array) { - if (variable_check (array, 0, false) == FAILURE) - return FAILURE; - if (allocatable_check (array, 0) == FAILURE) - return FAILURE; + if (!variable_check (array, 0, false)) + return false; + if (!allocatable_check (array, 0)) + return false; - return SUCCESS; + return true; } /* Common check function where the first argument must be real or integer and the second argument must be the same as the first. */ -gfc_try +bool gfc_check_a_p (gfc_expr *a, gfc_expr *p) { - if (int_or_real_check (a, 0) == FAILURE) - return FAILURE; + if (!int_or_real_check (a, 0)) + return false; if (a->ts.type != p->ts.type) { @@ -864,36 +863,36 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p) "have the same type", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &p->where); - return FAILURE; + return false; } if (a->ts.kind != p->ts.kind) { - if (gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", - &p->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", + &p->where)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_x_yd (gfc_expr *x, gfc_expr *y) { - if (double_check (x, 0) == FAILURE || double_check (y, 1) == FAILURE) - return FAILURE; + if (!double_check (x, 0) || !double_check (y, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_associated (gfc_expr *pointer, gfc_expr *target) { symbol_attribute attr1, attr2; int i; - gfc_try t; + bool t; locus *where; where = &pointer->where; @@ -908,7 +907,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &pointer->where); - return FAILURE; + return false; } /* F2008, C1242. */ @@ -917,12 +916,12 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be " "coindexed", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &pointer->where); - return FAILURE; + return false; } /* Target argument is optional. */ if (target == NULL) - return SUCCESS; + return true; where = &target->where; if (target->expr_type == EXPR_NULL) @@ -936,7 +935,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) "or target VARIABLE or FUNCTION", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &target->where); - return FAILURE; + return false; } if (attr1.pointer && !attr2.pointer && !attr2.target) @@ -944,7 +943,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER " "or a TARGET", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &target->where); - return FAILURE; + return false; } /* F2008, C1242. */ @@ -953,14 +952,14 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be " "coindexed", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &target->where); - return FAILURE; + return false; } - t = SUCCESS; - if (same_type_check (pointer, 0, target, 1) == FAILURE) - t = FAILURE; - if (rank_check (target, 0, pointer->rank) == FAILURE) - t = FAILURE; + t = true; + if (!same_type_check (pointer, 0, target, 1)) + t = false; + if (!rank_check (target, 0, pointer->rank)) + t = false; if (target->rank > 0) { for (i = 0; i < target->rank; i++) @@ -969,7 +968,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) gfc_error ("Array section with a vector subscript at %L shall not " "be the target of a pointer", &target->where); - t = FAILURE; + t = false; break; } } @@ -979,37 +978,37 @@ null_arg: gfc_error ("NULL pointer at %L is not permitted as actual argument " "of '%s' intrinsic function", where, gfc_current_intrinsic); - return FAILURE; + return false; } -gfc_try +bool gfc_check_atan_2 (gfc_expr *y, gfc_expr *x) { /* gfc_notify_std would be a waste of time as the return value is seemingly used only for the generic resolution. The error will be: Too many arguments. */ if ((gfc_option.allow_std & GFC_STD_F2008) == 0) - return FAILURE; + return false; return gfc_check_atan2 (y, x); } -gfc_try +bool gfc_check_atan2 (gfc_expr *y, gfc_expr *x) { - if (type_check (y, 0, BT_REAL) == FAILURE) - return FAILURE; - if (same_type_check (y, 0, x, 1) == FAILURE) - return FAILURE; + if (!type_check (y, 0, BT_REAL)) + return false; + if (!same_type_check (y, 0, x, 1)) + return false; - return SUCCESS; + return true; } -static gfc_try +static bool gfc_check_atomic (gfc_expr *atom, gfc_expr *value) { if (!(atom->ts.type == BT_INTEGER && atom->ts.kind == gfc_atomic_int_kind) @@ -1019,14 +1018,14 @@ gfc_check_atomic (gfc_expr *atom, gfc_expr *value) gfc_error ("ATOM argument at %L to intrinsic function %s shall be an " "integer of ATOMIC_INT_KIND or a logical of " "ATOMIC_LOGICAL_KIND", &atom->where, gfc_current_intrinsic); - return FAILURE; + return false; } if (!gfc_expr_attr (atom).codimension) { gfc_error ("ATOM argument at %L of the %s intrinsic function shall be a " "coarray or coindexed", &atom->where, gfc_current_intrinsic); - return FAILURE; + return false; } if (atom->ts.type != value->ts.type) @@ -1034,41 +1033,41 @@ gfc_check_atomic (gfc_expr *atom, gfc_expr *value) gfc_error ("ATOM and VALUE argument of the %s intrinsic function shall " "have the same type at %L", gfc_current_intrinsic, &value->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_atomic_def (gfc_expr *atom, gfc_expr *value) { - if (scalar_check (atom, 0) == FAILURE || scalar_check (value, 1) == FAILURE) - return FAILURE; + if (!scalar_check (atom, 0) || !scalar_check (value, 1)) + return false; - if (gfc_check_vardef_context (atom, false, false, false, NULL) == FAILURE) + if (!gfc_check_vardef_context (atom, false, false, false, NULL)) { gfc_error ("ATOM argument of the %s intrinsic function at %L shall be " "definable", gfc_current_intrinsic, &atom->where); - return FAILURE; + return false; } return gfc_check_atomic (atom, value); } -gfc_try +bool gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom) { - if (scalar_check (value, 0) == FAILURE || scalar_check (atom, 1) == FAILURE) - return FAILURE; + if (!scalar_check (value, 0) || !scalar_check (atom, 1)) + return false; - if (gfc_check_vardef_context (value, false, false, false, NULL) == FAILURE) + if (!gfc_check_vardef_context (value, false, false, false, NULL)) { gfc_error ("VALUE argument of the %s intrinsic function at %L shall be " "definable", gfc_current_intrinsic, &value->where); - return FAILURE; + return false; } return gfc_check_atomic (atom, value); @@ -1077,184 +1076,184 @@ gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom) /* BESJN and BESYN functions. */ -gfc_try +bool gfc_check_besn (gfc_expr *n, gfc_expr *x) { - if (type_check (n, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (n, 0, BT_INTEGER)) + return false; if (n->expr_type == EXPR_CONSTANT) { int i; gfc_extract_int (n, &i); - if (i < 0 && gfc_notify_std (GFC_STD_GNU, "Negative argument " - "N at %L", &n->where) == FAILURE) - return FAILURE; + if (i < 0 && !gfc_notify_std (GFC_STD_GNU, "Negative argument " + "N at %L", &n->where)) + return false; } - if (type_check (x, 1, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (x, 1, BT_REAL)) + return false; - return SUCCESS; + return true; } /* Transformational version of the Bessel JN and YN functions. */ -gfc_try +bool gfc_check_bessel_n2 (gfc_expr *n1, gfc_expr *n2, gfc_expr *x) { - if (type_check (n1, 0, BT_INTEGER) == FAILURE) - return FAILURE; - if (scalar_check (n1, 0) == FAILURE) - return FAILURE; - if (nonnegative_check("N1", n1) == FAILURE) - return FAILURE; - - if (type_check (n2, 1, BT_INTEGER) == FAILURE) - return FAILURE; - if (scalar_check (n2, 1) == FAILURE) - return FAILURE; - if (nonnegative_check("N2", n2) == FAILURE) - return FAILURE; + if (!type_check (n1, 0, BT_INTEGER)) + return false; + if (!scalar_check (n1, 0)) + return false; + if (!nonnegative_check ("N1", n1)) + return false; + + if (!type_check (n2, 1, BT_INTEGER)) + return false; + if (!scalar_check (n2, 1)) + return false; + if (!nonnegative_check ("N2", n2)) + return false; + + if (!type_check (x, 2, BT_REAL)) + return false; + if (!scalar_check (x, 2)) + return false; - if (type_check (x, 2, BT_REAL) == FAILURE) - return FAILURE; - if (scalar_check (x, 2) == FAILURE) - return FAILURE; - - return SUCCESS; + return true; } -gfc_try +bool gfc_check_bge_bgt_ble_blt (gfc_expr *i, gfc_expr *j) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (j, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (j, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (pos, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (pos, 1, BT_INTEGER)) + return false; - if (nonnegative_check ("pos", pos) == FAILURE) - return FAILURE; + if (!nonnegative_check ("pos", pos)) + return false; - if (less_than_bitsize1 ("i", i, "pos", pos, false) == FAILURE) - return FAILURE; + if (!less_than_bitsize1 ("i", i, "pos", pos, false)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_char (gfc_expr *i, gfc_expr *kind) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind_check (kind, 1, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; + if (!kind_check (kind, 1, BT_CHARACTER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_chdir (gfc_expr *dir) { - if (type_check (dir, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (dir, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (dir, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (dir, 0, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_chdir_sub (gfc_expr *dir, gfc_expr *status) { - if (type_check (dir, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (dir, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (dir, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (dir, 0, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 1, BT_INTEGER) == FAILURE) - return FAILURE; - if (scalar_check (status, 1) == FAILURE) - return FAILURE; + if (!type_check (status, 1, BT_INTEGER)) + return false; + if (!scalar_check (status, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_chmod (gfc_expr *name, gfc_expr *mode) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; - if (type_check (mode, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (mode, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (mode, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, gfc_expr *status) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; - if (type_check (mode, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (mode, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (mode, 1, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER)) + return false; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind) { - if (numeric_check (x, 0) == FAILURE) - return FAILURE; + if (!numeric_check (x, 0)) + return false; if (y != NULL) { - if (numeric_check (y, 1) == FAILURE) - return FAILURE; + if (!numeric_check (y, 1)) + return false; if (x->ts.type == BT_COMPLEX) { @@ -1262,7 +1261,7 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind) "present if 'x' is COMPLEX", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &y->where); - return FAILURE; + return false; } if (y->ts.type == BT_COMPLEX) @@ -1271,13 +1270,13 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind) "of either REAL or INTEGER", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &y->where); - return FAILURE; + return false; } } - if (kind_check (kind, 2, BT_COMPLEX) == FAILURE) - return FAILURE; + if (!kind_check (kind, 2, BT_COMPLEX)) + return false; if (!kind && gfc_option.gfc_warn_conversion && x->ts.type == BT_REAL && x->ts.kind > gfc_default_real_kind) @@ -1290,66 +1289,66 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind) "might loose precision, consider using the KIND argument", gfc_typename (&y->ts), gfc_default_real_kind, &y->where); - return SUCCESS; + return true; } -gfc_try +bool gfc_check_complex (gfc_expr *x, gfc_expr *y) { - if (int_or_real_check (x, 0) == FAILURE) - return FAILURE; - if (scalar_check (x, 0) == FAILURE) - return FAILURE; + if (!int_or_real_check (x, 0)) + return false; + if (!scalar_check (x, 0)) + return false; - if (int_or_real_check (y, 1) == FAILURE) - return FAILURE; - if (scalar_check (y, 1) == FAILURE) - return FAILURE; + if (!int_or_real_check (y, 1)) + return false; + if (!scalar_check (y, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) { - if (logical_array_check (mask, 0) == FAILURE) - return FAILURE; - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; - if (dim_rank_check (dim, mask, 0) == FAILURE) - return FAILURE; - if (kind_check (kind, 2, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!logical_array_check (mask, 0)) + return false; + if (!dim_check (dim, 1, false)) + return false; + if (!dim_rank_check (dim, mask, 0)) + return false; + if (!kind_check (kind, 2, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) { - if (array_check (array, 0) == FAILURE) - return FAILURE; + if (!array_check (array, 0)) + return false; - if (type_check (shift, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (shift, 1, BT_INTEGER)) + return false; - if (dim_check (dim, 2, true) == FAILURE) - return FAILURE; + if (!dim_check (dim, 2, true)) + return false; - if (dim_rank_check (dim, array, false) == FAILURE) - return FAILURE; + if (!dim_rank_check (dim, array, false)) + return false; if (array->rank == 1 || shift->rank == 0) { - if (scalar_check (shift, 1) == FAILURE) - return FAILURE; + if (!scalar_check (shift, 1)) + return false; } else if (shift->rank == array->rank - 1) { @@ -1375,7 +1374,7 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) gfc_current_intrinsic, &shift->where, i + 1, mpz_get_si (array->shape[i]), mpz_get_si (shift->shape[j])); - return FAILURE; + return false; } j += 1; @@ -1387,44 +1386,44 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank " "%d or be a scalar", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &shift->where, array->rank - 1); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ctime (gfc_expr *time) { - if (scalar_check (time, 0) == FAILURE) - return FAILURE; + if (!scalar_check (time, 0)) + return false; - if (type_check (time, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (time, 0, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try gfc_check_datan2 (gfc_expr *y, gfc_expr *x) +bool gfc_check_datan2 (gfc_expr *y, gfc_expr *x) { - if (double_check (y, 0) == FAILURE || double_check (x, 1) == FAILURE) - return FAILURE; + if (!double_check (y, 0) || !double_check (x, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_dcmplx (gfc_expr *x, gfc_expr *y) { - if (numeric_check (x, 0) == FAILURE) - return FAILURE; + if (!numeric_check (x, 0)) + return false; if (y != NULL) { - if (numeric_check (y, 1) == FAILURE) - return FAILURE; + if (!numeric_check (y, 1)) + return false; if (x->ts.type == BT_COMPLEX) { @@ -1432,7 +1431,7 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y) "present if 'x' is COMPLEX", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &y->where); - return FAILURE; + return false; } if (y->ts.type == BT_COMPLEX) @@ -1441,89 +1440,89 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y) "of either REAL or INTEGER", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &y->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_dble (gfc_expr *x) { - if (numeric_check (x, 0) == FAILURE) - return FAILURE; + if (!numeric_check (x, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_digits (gfc_expr *x) { - if (int_or_real_check (x, 0) == FAILURE) - return FAILURE; + if (!int_or_real_check (x, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b) { switch (vector_a->ts.type) { case BT_LOGICAL: - if (type_check (vector_b, 1, BT_LOGICAL) == FAILURE) - return FAILURE; + if (!type_check (vector_b, 1, BT_LOGICAL)) + return false; break; case BT_INTEGER: case BT_REAL: case BT_COMPLEX: - if (numeric_check (vector_b, 1) == FAILURE) - return FAILURE; + if (!numeric_check (vector_b, 1)) + return false; break; default: gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " "or LOGICAL", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &vector_a->where); - return FAILURE; + return false; } - if (rank_check (vector_a, 0, 1) == FAILURE) - return FAILURE; + if (!rank_check (vector_a, 0, 1)) + return false; - if (rank_check (vector_b, 1, 1) == FAILURE) - return FAILURE; + if (!rank_check (vector_b, 1, 1)) + return false; if (! identical_dimen_shape (vector_a, 0, vector_b, 0)) { gfc_error ("Different shape for arguments '%s' and '%s' at %L for " "intrinsic 'dot_product'", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic_arg[1]->name, &vector_a->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_dprod (gfc_expr *x, gfc_expr *y) { - if (type_check (x, 0, BT_REAL) == FAILURE - || type_check (y, 1, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_REAL) + || !type_check (y, 1, BT_REAL)) + return false; if (x->ts.kind != gfc_default_real_kind) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be default " "real", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &x->where); - return FAILURE; + return false; } if (y->ts.kind != gfc_default_real_kind) @@ -1531,75 +1530,75 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *y) gfc_error ("'%s' argument of '%s' intrinsic at %L must be default " "real", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &y->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (j, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (j, 1, BT_INTEGER)) + return false; if (i->is_boz && j->is_boz) { gfc_error ("'I' at %L and 'J' at %L cannot both be BOZ literal " "constants", &i->where, &j->where); - return FAILURE; + return false; } - if (!i->is_boz && !j->is_boz && same_type_check (i, 0, j, 1) == FAILURE) - return FAILURE; + if (!i->is_boz && !j->is_boz && !same_type_check (i, 0, j, 1)) + return false; - if (type_check (shift, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (shift, 2, BT_INTEGER)) + return false; - if (nonnegative_check ("SHIFT", shift) == FAILURE) - return FAILURE; + if (!nonnegative_check ("SHIFT", shift)) + return false; if (i->is_boz) { - if (less_than_bitsize1 ("J", j, "SHIFT", shift, true) == FAILURE) - return FAILURE; + if (!less_than_bitsize1 ("J", j, "SHIFT", shift, true)) + return false; i->ts.kind = j->ts.kind; } else { - if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE) - return FAILURE; + if (!less_than_bitsize1 ("I", i, "SHIFT", shift, true)) + return false; j->ts.kind = i->ts.kind; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, gfc_expr *dim) { - if (array_check (array, 0) == FAILURE) - return FAILURE; + if (!array_check (array, 0)) + return false; - if (type_check (shift, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (shift, 1, BT_INTEGER)) + return false; - if (dim_check (dim, 3, true) == FAILURE) - return FAILURE; + if (!dim_check (dim, 3, true)) + return false; - if (dim_rank_check (dim, array, false) == FAILURE) - return FAILURE; + if (!dim_rank_check (dim, array, false)) + return false; if (array->rank == 1 || shift->rank == 0) { - if (scalar_check (shift, 1) == FAILURE) - return FAILURE; + if (!scalar_check (shift, 1)) + return false; } else if (shift->rank == array->rank - 1) { @@ -1625,7 +1624,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, gfc_current_intrinsic, &shift->where, i + 1, mpz_get_si (array->shape[i]), mpz_get_si (shift->shape[j])); - return FAILURE; + return false; } j += 1; @@ -1637,28 +1636,28 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank " "%d or be a scalar", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &shift->where, array->rank - 1); - return FAILURE; + return false; } if (boundary != NULL) { - if (same_type_check (array, 0, boundary, 2) == FAILURE) - return FAILURE; + if (!same_type_check (array, 0, boundary, 2)) + return false; if (array->rank == 1 || boundary->rank == 0) { - if (scalar_check (boundary, 2) == FAILURE) - return FAILURE; + if (!scalar_check (boundary, 2)) + return false; } else if (boundary->rank == array->rank - 1) { - if (gfc_check_conformance (shift, boundary, - "arguments '%s' and '%s' for " - "intrinsic %s", - gfc_current_intrinsic_arg[1]->name, - gfc_current_intrinsic_arg[2]->name, - gfc_current_intrinsic ) == FAILURE) - return FAILURE; + if (!gfc_check_conformance (shift, boundary, + "arguments '%s' and '%s' for " + "intrinsic %s", + gfc_current_intrinsic_arg[1]->name, + gfc_current_intrinsic_arg[2]->name, + gfc_current_intrinsic)) + return false; } else { @@ -1666,197 +1665,197 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, "rank %d or be a scalar", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &shift->where, array->rank - 1); - return FAILURE; + return false; } } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_float (gfc_expr *a) { - if (type_check (a, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_INTEGER)) + return false; if ((a->ts.kind != gfc_default_integer_kind) - && gfc_notify_std (GFC_STD_GNU, "non-default INTEGER " - "kind argument to %s intrinsic at %L", - gfc_current_intrinsic, &a->where) == FAILURE ) - return FAILURE; + && !gfc_notify_std (GFC_STD_GNU, "non-default INTEGER " + "kind argument to %s intrinsic at %L", + gfc_current_intrinsic, &a->where)) + return false; - return SUCCESS; + return true; } /* A single complex argument. */ -gfc_try +bool gfc_check_fn_c (gfc_expr *a) { - if (type_check (a, 0, BT_COMPLEX) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_COMPLEX)) + return false; - return SUCCESS; + return true; } /* A single real argument. */ -gfc_try +bool gfc_check_fn_r (gfc_expr *a) { - if (type_check (a, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_REAL)) + return false; - return SUCCESS; + return true; } /* A single double argument. */ -gfc_try +bool gfc_check_fn_d (gfc_expr *a) { - if (double_check (a, 0) == FAILURE) - return FAILURE; + if (!double_check (a, 0)) + return false; - return SUCCESS; + return true; } /* A single real or complex argument. */ -gfc_try +bool gfc_check_fn_rc (gfc_expr *a) { - if (real_or_complex_check (a, 0) == FAILURE) - return FAILURE; + if (!real_or_complex_check (a, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_fn_rc2008 (gfc_expr *a) { - if (real_or_complex_check (a, 0) == FAILURE) - return FAILURE; + if (!real_or_complex_check (a, 0)) + return false; if (a->ts.type == BT_COMPLEX - && gfc_notify_std (GFC_STD_F2008, "COMPLEX argument '%s' " - "argument of '%s' intrinsic at %L", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic, &a->where) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2008, "COMPLEX argument '%s' " + "argument of '%s' intrinsic at %L", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic, &a->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_fnum (gfc_expr *unit) { - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_huge (gfc_expr *x) { - if (int_or_real_check (x, 0) == FAILURE) - return FAILURE; + if (!int_or_real_check (x, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_hypot (gfc_expr *x, gfc_expr *y) { - if (type_check (x, 0, BT_REAL) == FAILURE) - return FAILURE; - if (same_type_check (x, 0, y, 1) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_REAL)) + return false; + if (!same_type_check (x, 0, y, 1)) + return false; - return SUCCESS; + return true; } /* Check that the single argument is an integer. */ -gfc_try +bool gfc_check_i (gfc_expr *i) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_iand (gfc_expr *i, gfc_expr *j) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (j, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (j, 1, BT_INTEGER)) + return false; if (i->ts.kind != j->ts.kind) { - if (gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", - &i->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", + &i->where)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ibits (gfc_expr *i, gfc_expr *pos, gfc_expr *len) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (pos, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (pos, 1, BT_INTEGER)) + return false; - if (type_check (len, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (len, 2, BT_INTEGER)) + return false; - if (nonnegative_check ("pos", pos) == FAILURE) - return FAILURE; + if (!nonnegative_check ("pos", pos)) + return false; - if (nonnegative_check ("len", len) == FAILURE) - return FAILURE; + if (!nonnegative_check ("len", len)) + return false; - if (less_than_bitsize2 ("i", i, "pos", pos, "len", len) == FAILURE) - return FAILURE; + if (!less_than_bitsize2 ("i", i, "pos", pos, "len", len)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) { int i; - if (type_check (c, 0, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (c, 0, BT_CHARACTER)) + return false; - if (kind_check (kind, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!kind_check (kind, 1, BT_INTEGER)) + return false; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; if (c->expr_type == EXPR_VARIABLE || c->expr_type == EXPR_SUBSTRING) { @@ -1879,11 +1878,11 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) { /* If we already have a length for this expression then use it. */ if (c->ts.u.cl->length->expr_type != EXPR_CONSTANT) - return SUCCESS; + return true; i = mpz_get_si (c->ts.u.cl->length->value.integer); } else - return SUCCESS; + return true; } else { @@ -1893,73 +1892,73 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) gcc_assert (start); if (end == NULL || end->expr_type != EXPR_CONSTANT || start->expr_type != EXPR_CONSTANT) - return SUCCESS; + return true; i = mpz_get_si (end->value.integer) + 1 - mpz_get_si (start->value.integer); } } else - return SUCCESS; + return true; if (i != 1) { gfc_error ("Argument of %s at %L must be of length one", gfc_current_intrinsic, &c->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_idnint (gfc_expr *a) { - if (double_check (a, 0) == FAILURE) - return FAILURE; + if (!double_check (a, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ieor (gfc_expr *i, gfc_expr *j) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (j, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (j, 1, BT_INTEGER)) + return false; if (i->ts.kind != j->ts.kind) { - if (gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", - &i->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", + &i->where)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back, gfc_expr *kind) { - if (type_check (string, 0, BT_CHARACTER) == FAILURE - || type_check (substring, 1, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (string, 0, BT_CHARACTER) + || !type_check (substring, 1, BT_CHARACTER)) + return false; - if (back != NULL && type_check (back, 2, BT_LOGICAL) == FAILURE) - return FAILURE; + if (back != NULL && !type_check (back, 2, BT_LOGICAL)) + return false; - if (kind_check (kind, 3, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!kind_check (kind, 3, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; if (string->ts.kind != substring->ts.kind) { @@ -1967,86 +1966,86 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back, "kind as '%s'", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &substring->where, gfc_current_intrinsic_arg[0]->name); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_int (gfc_expr *x, gfc_expr *kind) { - if (numeric_check (x, 0) == FAILURE) - return FAILURE; + if (!numeric_check (x, 0)) + return false; - if (kind_check (kind, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!kind_check (kind, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_intconv (gfc_expr *x) { - if (numeric_check (x, 0) == FAILURE) - return FAILURE; + if (!numeric_check (x, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ior (gfc_expr *i, gfc_expr *j) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (j, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (j, 1, BT_INTEGER)) + return false; if (i->ts.kind != j->ts.kind) { - if (gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", - &i->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", + &i->where)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ishft (gfc_expr *i, gfc_expr *shift) { - if (type_check (i, 0, BT_INTEGER) == FAILURE - || type_check (shift, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER) + || !type_check (shift, 1, BT_INTEGER)) + return false; - if (less_than_bitsize1 ("I", i, NULL, shift, true) == FAILURE) - return FAILURE; + if (!less_than_bitsize1 ("I", i, NULL, shift, true)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size) { - if (type_check (i, 0, BT_INTEGER) == FAILURE - || type_check (shift, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER) + || !type_check (shift, 1, BT_INTEGER)) + return false; if (size != NULL) { int i2, i3; - if (type_check (size, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (size, 2, BT_INTEGER)) + return false; - if (less_than_bitsize1 ("I", i, "SIZE", size, true) == FAILURE) - return FAILURE; + if (!less_than_bitsize1 ("I", i, "SIZE", size, true)) + return false; if (size->expr_type == EXPR_CONSTANT) { @@ -2054,7 +2053,7 @@ gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size) if (i3 <= 0) { gfc_error ("SIZE at %L must be positive", &size->where); - return FAILURE; + return false; } if (shift->expr_type == EXPR_CONSTANT) @@ -2068,60 +2067,60 @@ gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size) gfc_error ("The absolute value of SHIFT at %L must be less " "than or equal to SIZE at %L", &shift->where, &size->where); - return FAILURE; + return false; } } } } - else if (less_than_bitsize1 ("I", i, NULL, shift, true) == FAILURE) - return FAILURE; + else if (!less_than_bitsize1 ("I", i, NULL, shift, true)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_kill (gfc_expr *pid, gfc_expr *sig) { - if (type_check (pid, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (pid, 0, BT_INTEGER)) + return false; - if (type_check (sig, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (sig, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_expr *status) { - if (type_check (pid, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (pid, 0, BT_INTEGER)) + return false; - if (scalar_check (pid, 0) == FAILURE) - return FAILURE; + if (!scalar_check (pid, 0)) + return false; - if (type_check (sig, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (sig, 1, BT_INTEGER)) + return false; - if (scalar_check (sig, 1) == FAILURE) - return FAILURE; + if (!scalar_check (sig, 1)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER)) + return false; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_kind (gfc_expr *x) { if (x->ts.type == BT_DERIVED) @@ -2129,220 +2128,220 @@ gfc_check_kind (gfc_expr *x) gfc_error ("'%s' argument of '%s' intrinsic at %L must be a " "non-derived type", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &x->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { - if (array_check (array, 0) == FAILURE) - return FAILURE; + if (!array_check (array, 0)) + return false; - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (dim, 1, false)) + return false; - if (dim_rank_check (dim, array, 1) == FAILURE) - return FAILURE; + if (!dim_rank_check (dim, array, 1)) + return false; - if (kind_check (kind, 2, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!kind_check (kind, 2, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_lcobound (gfc_expr *coarray, gfc_expr *dim, gfc_expr *kind) { if (gfc_option.coarray == GFC_FCOARRAY_NONE) { gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable"); - return FAILURE; + return false; } - if (coarray_check (coarray, 0) == FAILURE) - return FAILURE; + if (!coarray_check (coarray, 0)) + return false; if (dim != NULL) { - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (dim, 1, false)) + return false; - if (dim_corank_check (dim, coarray) == FAILURE) - return FAILURE; + if (!dim_corank_check (dim, coarray)) + return false; } - if (kind_check (kind, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!kind_check (kind, 2, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind) { - if (type_check (s, 0, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (s, 0, BT_CHARACTER)) + return false; - if (kind_check (kind, 1, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!kind_check (kind, 1, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_lge_lgt_lle_llt (gfc_expr *a, gfc_expr *b) { - if (type_check (a, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (a, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (a, 0, gfc_default_character_kind)) + return false; - if (type_check (b, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (b, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (b, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (b, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_link (gfc_expr *path1, gfc_expr *path2) { - if (type_check (path1, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path1, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (path1, 0, gfc_default_character_kind)) + return false; - if (type_check (path2, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path2, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (path2, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_link_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { - if (type_check (path1, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path1, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (path1, 0, gfc_default_character_kind)) + return false; - if (type_check (path2, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path2, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path2, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (path2, 0, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER)) + return false; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_loc (gfc_expr *expr) { return variable_check (expr, 0, true); } -gfc_try +bool gfc_check_symlnk (gfc_expr *path1, gfc_expr *path2) { - if (type_check (path1, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path1, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (path1, 0, gfc_default_character_kind)) + return false; - if (type_check (path2, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path2, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (path2, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_symlnk_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { - if (type_check (path1, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path1, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (path1, 0, gfc_default_character_kind)) + return false; - if (type_check (path2, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path2, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (path2, 1, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER)) + return false; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_logical (gfc_expr *a, gfc_expr *kind) { - if (type_check (a, 0, BT_LOGICAL) == FAILURE) - return FAILURE; - if (kind_check (kind, 1, BT_LOGICAL) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_LOGICAL)) + return false; + if (!kind_check (kind, 1, BT_LOGICAL)) + return false; - return SUCCESS; + return true; } /* Min/max family. */ -static gfc_try +static bool min_max_args (gfc_actual_arglist *arg) { if (arg == NULL || arg->next == NULL) { gfc_error ("Intrinsic '%s' at %L must have at least two arguments", gfc_current_intrinsic, gfc_current_intrinsic_where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -static gfc_try +static bool check_rest (bt type, int kind, gfc_actual_arglist *arglist) { gfc_actual_arglist *arg, *tmp; @@ -2350,8 +2349,8 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist) gfc_expr *x; int m, n; - if (min_max_args (arglist) == FAILURE) - return FAILURE; + if (!min_max_args (arglist)) + return false; for (arg = arglist, n=1; arg; arg = arg->next, n++) { @@ -2360,74 +2359,74 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist) { if (x->ts.type == type) { - if (gfc_notify_std (GFC_STD_GNU, "Different type " - "kinds at %L", &x->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "Different type " + "kinds at %L", &x->where)) + return false; } else { gfc_error ("'a%d' argument of '%s' intrinsic at %L must be " "%s(%d)", n, gfc_current_intrinsic, &x->where, gfc_basic_typename (type), kind); - return FAILURE; + return false; } } for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++) - if (gfc_check_conformance (tmp->expr, x, - "arguments 'a%d' and 'a%d' for " - "intrinsic '%s'", m, n, - gfc_current_intrinsic) == FAILURE) - return FAILURE; + if (!gfc_check_conformance (tmp->expr, x, + "arguments 'a%d' and 'a%d' for " + "intrinsic '%s'", m, n, + gfc_current_intrinsic)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_min_max (gfc_actual_arglist *arg) { gfc_expr *x; - if (min_max_args (arg) == FAILURE) - return FAILURE; + if (!min_max_args (arg)) + return false; x = arg->expr; if (x->ts.type == BT_CHARACTER) { - if (gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with CHARACTER argument at %L", - gfc_current_intrinsic, &x->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with CHARACTER argument at %L", + gfc_current_intrinsic, &x->where)) + return false; } else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL) { gfc_error ("'a1' argument of '%s' intrinsic at %L must be INTEGER, " "REAL or CHARACTER", gfc_current_intrinsic, &x->where); - return FAILURE; + return false; } return check_rest (x->ts.type, x->ts.kind, arg); } -gfc_try +bool gfc_check_min_max_integer (gfc_actual_arglist *arg) { return check_rest (BT_INTEGER, gfc_default_integer_kind, arg); } -gfc_try +bool gfc_check_min_max_real (gfc_actual_arglist *arg) { return check_rest (BT_REAL, gfc_default_real_kind, arg); } -gfc_try +bool gfc_check_min_max_double (gfc_actual_arglist *arg) { return check_rest (BT_REAL, gfc_default_double_kind, arg); @@ -2436,20 +2435,20 @@ gfc_check_min_max_double (gfc_actual_arglist *arg) /* End of min/max family. */ -gfc_try +bool gfc_check_malloc (gfc_expr *size) { - if (type_check (size, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (size, 0, BT_INTEGER)) + return false; - if (scalar_check (size, 0) == FAILURE) - return FAILURE; + if (!scalar_check (size, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) { if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts)) @@ -2457,7 +2456,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " "or LOGICAL", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &matrix_a->where); - return FAILURE; + return false; } if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts)) @@ -2465,7 +2464,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " "or LOGICAL", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &matrix_b->where); - return FAILURE; + return false; } if ((matrix_a->ts.type == BT_LOGICAL && gfc_numeric_ts (&matrix_b->ts)) @@ -2474,14 +2473,14 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) gfc_error ("Argument types of '%s' intrinsic at %L must match (%s/%s)", gfc_current_intrinsic, &matrix_a->where, gfc_typename(&matrix_a->ts), gfc_typename(&matrix_b->ts)); - return FAILURE; + return false; } switch (matrix_a->rank) { case 1: - if (rank_check (matrix_b, 1, 2) == FAILURE) - return FAILURE; + if (!rank_check (matrix_b, 1, 2)) + return false; /* Check for case matrix_a has shape(m), matrix_b has shape (m, k). */ if (!identical_dimen_shape (matrix_a, 0, matrix_b, 0)) { @@ -2489,15 +2488,15 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) "and '%s' at %L for intrinsic matmul", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic_arg[1]->name, &matrix_a->where); - return FAILURE; + return false; } break; case 2: if (matrix_b->rank != 2) { - if (rank_check (matrix_b, 1, 1) == FAILURE) - return FAILURE; + if (!rank_check (matrix_b, 1, 1)) + return false; } /* matrix_b has rank 1 or 2 here. Common check for the cases - matrix_a has shape (n,m) and matrix_b has shape (m, k) @@ -2508,7 +2507,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) "dimension 1 for argument '%s' at %L for intrinsic " "matmul", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic_arg[1]->name, &matrix_a->where); - return FAILURE; + return false; } break; @@ -2516,10 +2515,10 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank " "1 or 2", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &matrix_a->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -2537,14 +2536,14 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) I.e. in the case of minloc(array,mask), mask will be in the second position of the argument list and we'll have to fix that up. */ -gfc_try +bool gfc_check_minloc_maxloc (gfc_actual_arglist *ap) { gfc_expr *a, *m, *d; a = ap->expr; - if (int_or_real_check (a, 0) == FAILURE || array_check (a, 0) == FAILURE) - return FAILURE; + if (!int_or_real_check (a, 0) || !array_check (a, 0)) + return false; d = ap->next->expr; m = ap->next->next->expr; @@ -2558,24 +2557,24 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap) ap->next->next->expr = m; } - if (dim_check (d, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (d, 1, false)) + return false; - if (dim_rank_check (d, a, 0) == FAILURE) - return FAILURE; + if (!dim_rank_check (d, a, 0)) + return false; - if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE) - return FAILURE; + if (m != NULL && !type_check (m, 2, BT_LOGICAL)) + return false; if (m != NULL - && gfc_check_conformance (a, m, - "arguments '%s' and '%s' for intrinsic %s", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic_arg[2]->name, - gfc_current_intrinsic ) == FAILURE) - return FAILURE; + && !gfc_check_conformance (a, m, + "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic_arg[2]->name, + gfc_current_intrinsic)) + return false; - return SUCCESS; + return true; } @@ -2594,7 +2593,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap) I.e. in the case of minval(array,mask), mask will be in the second position of the argument list and we'll have to fix that up. */ -static gfc_try +static bool check_reduction (gfc_actual_arglist *ap) { gfc_expr *a, *m, *d; @@ -2612,44 +2611,44 @@ check_reduction (gfc_actual_arglist *ap) ap->next->next->expr = m; } - if (dim_check (d, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (d, 1, false)) + return false; - if (dim_rank_check (d, a, 0) == FAILURE) - return FAILURE; + if (!dim_rank_check (d, a, 0)) + return false; - if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE) - return FAILURE; + if (m != NULL && !type_check (m, 2, BT_LOGICAL)) + return false; if (m != NULL - && gfc_check_conformance (a, m, - "arguments '%s' and '%s' for intrinsic %s", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic_arg[2]->name, - gfc_current_intrinsic) == FAILURE) - return FAILURE; + && !gfc_check_conformance (a, m, + "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic_arg[2]->name, + gfc_current_intrinsic)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_minval_maxval (gfc_actual_arglist *ap) { - if (int_or_real_check (ap->expr, 0) == FAILURE - || array_check (ap->expr, 0) == FAILURE) - return FAILURE; + if (!int_or_real_check (ap->expr, 0) + || !array_check (ap->expr, 0)) + return false; return check_reduction (ap); } -gfc_try +bool gfc_check_product_sum (gfc_actual_arglist *ap) { - if (numeric_check (ap->expr, 0) == FAILURE - || array_check (ap->expr, 0) == FAILURE) - return FAILURE; + if (!numeric_check (ap->expr, 0) + || !array_check (ap->expr, 0)) + return false; return check_reduction (ap); } @@ -2657,33 +2656,33 @@ gfc_check_product_sum (gfc_actual_arglist *ap) /* For IANY, IALL and IPARITY. */ -gfc_try +bool gfc_check_mask (gfc_expr *i, gfc_expr *kind) { int k; - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (nonnegative_check ("I", i) == FAILURE) - return FAILURE; + if (!nonnegative_check ("I", i)) + return false; - if (kind_check (kind, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!kind_check (kind, 1, BT_INTEGER)) + return false; if (kind) gfc_extract_int (kind, &k); else k = gfc_default_integer_kind; - if (less_than_bitsizekind ("I", i, k) == FAILURE) - return FAILURE; + if (!less_than_bitsizekind ("I", i, k)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_transf_bit_intrins (gfc_actual_arglist *ap) { if (ap->expr->ts.type != BT_INTEGER) @@ -2691,77 +2690,77 @@ gfc_check_transf_bit_intrins (gfc_actual_arglist *ap) gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &ap->expr->where); - return FAILURE; + return false; } - if (array_check (ap->expr, 0) == FAILURE) - return FAILURE; + if (!array_check (ap->expr, 0)) + return false; return check_reduction (ap); } -gfc_try +bool gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask) { - if (same_type_check (tsource, 0, fsource, 1) == FAILURE) - return FAILURE; + if (!same_type_check (tsource, 0, fsource, 1)) + return false; - if (type_check (mask, 2, BT_LOGICAL) == FAILURE) - return FAILURE; + if (!type_check (mask, 2, BT_LOGICAL)) + return false; if (tsource->ts.type == BT_CHARACTER) return gfc_check_same_strlen (tsource, fsource, "MERGE intrinsic"); - return SUCCESS; + return true; } -gfc_try +bool gfc_check_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (j, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (j, 1, BT_INTEGER)) + return false; - if (type_check (mask, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (mask, 2, BT_INTEGER)) + return false; - if (same_type_check (i, 0, j, 1) == FAILURE) - return FAILURE; + if (!same_type_check (i, 0, j, 1)) + return false; - if (same_type_check (i, 0, mask, 2) == FAILURE) - return FAILURE; + if (!same_type_check (i, 0, mask, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) { - if (variable_check (from, 0, false) == FAILURE) - return FAILURE; - if (allocatable_check (from, 0) == FAILURE) - return FAILURE; + if (!variable_check (from, 0, false)) + return false; + if (!allocatable_check (from, 0)) + return false; if (gfc_is_coindexed (from)) { gfc_error ("The FROM argument to MOVE_ALLOC at %L shall not be " "coindexed", &from->where); - return FAILURE; + return false; } - if (variable_check (to, 1, false) == FAILURE) - return FAILURE; - if (allocatable_check (to, 1) == FAILURE) - return FAILURE; + if (!variable_check (to, 1, false)) + return false; + if (!allocatable_check (to, 1)) + return false; if (gfc_is_coindexed (to)) { gfc_error ("The TO argument to MOVE_ALLOC at %L shall not be " "coindexed", &to->where); - return FAILURE; + return false; } if (from->ts.type == BT_CLASS && to->ts.type == BT_DERIVED) @@ -2769,18 +2768,18 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) gfc_error ("The TO arguments in MOVE_ALLOC at %L must be " "polymorphic if FROM is polymorphic", &to->where); - return FAILURE; + return false; } - if (same_type_check (to, 1, from, 0) == FAILURE) - return FAILURE; + if (!same_type_check (to, 1, from, 0)) + return false; if (to->rank != from->rank) { gfc_error ("The FROM and TO arguments of the MOVE_ALLOC intrinsic at %L " "must have the same rank %d/%d", &to->where, from->rank, to->rank); - return FAILURE; + return false; } /* IR F08/0040; cf. 12-006A. */ @@ -2789,7 +2788,7 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) gfc_error ("The FROM and TO arguments of the MOVE_ALLOC intrinsic at %L " "must have the same corank %d/%d", &to->where, gfc_get_corank (from), gfc_get_corank (to)); - return FAILURE; + return false; } /* CLASS arguments: Make sure the vtab of from is present. */ @@ -2801,18 +2800,18 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) gfc_find_intrinsic_vtab (&from->ts); } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_nearest (gfc_expr *x, gfc_expr *s) { - if (type_check (x, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_REAL)) + return false; - if (type_check (s, 1, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (s, 1, BT_REAL)) + return false; if (s->expr_type == EXPR_CONSTANT) { @@ -2820,49 +2819,49 @@ gfc_check_nearest (gfc_expr *x, gfc_expr *s) { gfc_error ("Argument 'S' of NEAREST at %L shall not be zero", &s->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_new_line (gfc_expr *a) { - if (type_check (a, 0, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_CHARACTER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_norm2 (gfc_expr *array, gfc_expr *dim) { - if (type_check (array, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (array, 0, BT_REAL)) + return false; - if (array_check (array, 0) == FAILURE) - return FAILURE; + if (!array_check (array, 0)) + return false; - if (dim_rank_check (dim, array, false) == FAILURE) - return FAILURE; + if (!dim_rank_check (dim, array, false)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_null (gfc_expr *mold) { symbol_attribute attr; if (mold == NULL) - return SUCCESS; + return true; - if (variable_check (mold, 0, true) == FAILURE) - return FAILURE; + if (!variable_check (mold, 0, true)) + return false; attr = gfc_variable_attr (mold, NULL); @@ -2872,13 +2871,13 @@ gfc_check_null (gfc_expr *mold) "ALLOCATABLE or procedure pointer", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &mold->where); - return FAILURE; + return false; } if (attr.allocatable - && gfc_notify_std (GFC_STD_F2003, "NULL intrinsic with " - "allocatable MOLD at %L", &mold->where) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2003, "NULL intrinsic with " + "allocatable MOLD at %L", &mold->where)) + return false; /* F2008, C1242. */ if (gfc_is_coindexed (mold)) @@ -2886,44 +2885,44 @@ gfc_check_null (gfc_expr *mold) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be " "coindexed", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &mold->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector) { - if (array_check (array, 0) == FAILURE) - return FAILURE; + if (!array_check (array, 0)) + return false; - if (type_check (mask, 1, BT_LOGICAL) == FAILURE) - return FAILURE; + if (!type_check (mask, 1, BT_LOGICAL)) + return false; - if (gfc_check_conformance (array, mask, - "arguments '%s' and '%s' for intrinsic '%s'", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic_arg[1]->name, - gfc_current_intrinsic) == FAILURE) - return FAILURE; + if (!gfc_check_conformance (array, mask, + "arguments '%s' and '%s' for intrinsic '%s'", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic_arg[1]->name, + gfc_current_intrinsic)) + return false; if (vector != NULL) { mpz_t array_size, vector_size; bool have_array_size, have_vector_size; - if (same_type_check (array, 0, vector, 2) == FAILURE) - return FAILURE; + if (!same_type_check (array, 0, vector, 2)) + return false; - if (rank_check (vector, 2, 1) == FAILURE) - return FAILURE; + if (!rank_check (vector, 2, 1)) + return false; /* VECTOR requires at least as many elements as MASK has .TRUE. values. */ - have_array_size = gfc_array_size (array, &array_size) == SUCCESS; - have_vector_size = gfc_array_size (vector, &vector_size) == SUCCESS; + have_array_size = gfc_array_size(array, &array_size); + have_vector_size = gfc_array_size(vector, &vector_size); if (have_vector_size && (mask->expr_type == EXPR_ARRAY @@ -2962,7 +2961,7 @@ gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector) gfc_current_intrinsic, &vector->where, gfc_current_intrinsic_arg[1]->name, mpz_get_si (vector_size), mask_true_values); - return FAILURE; + return false; } } @@ -2972,43 +2971,43 @@ gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector) mpz_clear (vector_size); } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_parity (gfc_expr *mask, gfc_expr *dim) { - if (type_check (mask, 0, BT_LOGICAL) == FAILURE) - return FAILURE; + if (!type_check (mask, 0, BT_LOGICAL)) + return false; - if (array_check (mask, 0) == FAILURE) - return FAILURE; + if (!array_check (mask, 0)) + return false; - if (dim_rank_check (dim, mask, false) == FAILURE) - return FAILURE; + if (!dim_rank_check (dim, mask, false)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_precision (gfc_expr *x) { - if (real_or_complex_check (x, 0) == FAILURE) - return FAILURE; + if (!real_or_complex_check (x, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_present (gfc_expr *a) { gfc_symbol *sym; - if (variable_check (a, 0, true) == FAILURE) - return FAILURE; + if (!variable_check (a, 0, true)) + return false; sym = a->symtree->n.sym; if (!sym->attr.dummy) @@ -3016,7 +3015,7 @@ gfc_check_present (gfc_expr *a) gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a " "dummy variable", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &a->where); - return FAILURE; + return false; } if (!sym->attr.optional) @@ -3025,7 +3024,7 @@ gfc_check_present (gfc_expr *a) "an OPTIONAL dummy variable", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &a->where); - return FAILURE; + return false; } /* 13.14.82 PRESENT(A) @@ -3043,34 +3042,34 @@ gfc_check_present (gfc_expr *a) gfc_error ("'%s' argument of '%s' intrinsic at %L must not be a " "subobject of '%s'", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &a->where, sym->name); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_radix (gfc_expr *x) { - if (int_or_real_check (x, 0) == FAILURE) - return FAILURE; + if (!int_or_real_check (x, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_range (gfc_expr *x) { - if (numeric_check (x, 0) == FAILURE) - return FAILURE; + if (!numeric_check (x, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_rank (gfc_expr *a ATTRIBUTE_UNUSED) { /* Any data object is allowed; a "data object" is a "constant (4.1.3), @@ -3090,90 +3089,90 @@ gfc_check_rank (gfc_expr *a ATTRIBUTE_UNUSED) { gfc_error ("The argument of the RANK intrinsic at %L must be a data " "object", &a->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* real, float, sngl. */ -gfc_try +bool gfc_check_real (gfc_expr *a, gfc_expr *kind) { - if (numeric_check (a, 0) == FAILURE) - return FAILURE; + if (!numeric_check (a, 0)) + return false; - if (kind_check (kind, 1, BT_REAL) == FAILURE) - return FAILURE; + if (!kind_check (kind, 1, BT_REAL)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_rename (gfc_expr *path1, gfc_expr *path2) { - if (type_check (path1, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path1, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (path1, 0, gfc_default_character_kind)) + return false; - if (type_check (path2, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path2, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (path2, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_rename_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status) { - if (type_check (path1, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path1, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (path1, 0, gfc_default_character_kind)) + return false; - if (type_check (path2, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (path2, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (path2, 1, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER)) + return false; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_repeat (gfc_expr *x, gfc_expr *y) { - if (type_check (x, 0, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_CHARACTER)) + return false; - if (scalar_check (x, 0) == FAILURE) - return FAILURE; + if (!scalar_check (x, 0)) + return false; - if (type_check (y, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (y, 0, BT_INTEGER)) + return false; - if (scalar_check (y, 1) == FAILURE) - return FAILURE; + if (!scalar_check (y, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_reshape (gfc_expr *source, gfc_expr *shape, gfc_expr *pad, gfc_expr *order) { @@ -3181,20 +3180,20 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, mpz_t nelems; int shape_size; - if (array_check (source, 0) == FAILURE) - return FAILURE; + if (!array_check (source, 0)) + return false; - if (rank_check (shape, 1, 1) == FAILURE) - return FAILURE; + if (!rank_check (shape, 1, 1)) + return false; - if (type_check (shape, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (shape, 1, BT_INTEGER)) + return false; - if (gfc_array_size (shape, &size) != SUCCESS) + if (!gfc_array_size (shape, &size)) { gfc_error ("'shape' argument of 'reshape' intrinsic at %L must be an " "array of constant size", &shape->where); - return FAILURE; + return false; } shape_size = mpz_get_ui (size); @@ -3205,13 +3204,13 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, gfc_error ("'%s' argument of '%s' intrinsic at %L is empty", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &shape->where); - return FAILURE; + return false; } else if (shape_size > GFC_MAX_DIMENSIONS) { gfc_error ("'shape' argument of 'reshape' intrinsic at %L has more " "than %d elements", &shape->where, GFC_MAX_DIMENSIONS); - return FAILURE; + return false; } else if (shape->expr_type == EXPR_ARRAY) { @@ -3230,27 +3229,27 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, "negative element (%d)", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &e->where, extent); - return FAILURE; + return false; } } } if (pad != NULL) { - if (same_type_check (source, 0, pad, 2) == FAILURE) - return FAILURE; + if (!same_type_check (source, 0, pad, 2)) + return false; - if (array_check (pad, 2) == FAILURE) - return FAILURE; + if (!array_check (pad, 2)) + return false; } if (order != NULL) { - if (array_check (order, 3) == FAILURE) - return FAILURE; + if (!array_check (order, 3)) + return false; - if (type_check (order, 3, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (order, 3, BT_INTEGER)) + return false; if (order->expr_type == EXPR_ARRAY) { @@ -3271,7 +3270,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, gfc_current_intrinsic_arg[3]->name, gfc_current_intrinsic, &order->where, order_size, shape_size); - return FAILURE; + return false; } for (i = 1; i <= order_size; ++i) @@ -3288,7 +3287,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, "has out-of-range dimension (%d)", gfc_current_intrinsic_arg[3]->name, gfc_current_intrinsic, &e->where, dim); - return FAILURE; + return false; } if (perm[dim-1] != 0) @@ -3298,7 +3297,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, "'%d' duplicated)", gfc_current_intrinsic_arg[3]->name, gfc_current_intrinsic, &e->where, dim); - return FAILURE; + return false; } perm[dim-1] = 1; @@ -3312,7 +3311,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, && source->symtree->n.sym->as->type == AS_ASSUMED_SIZE)) { /* Check the match in size between source and destination. */ - if (gfc_array_size (source, &nelems) == SUCCESS) + if (gfc_array_size (source, &nelems)) { gfc_constructor *c; bool test; @@ -3332,16 +3331,16 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, gfc_error ("Without padding, there are not enough elements " "in the intrinsic RESHAPE source at %L to match " "the shape", &source->where); - return FAILURE; + return false; } } } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_same_type_as (gfc_expr *a, gfc_expr *b) { if (a->ts.type != BT_DERIVED && a->ts.type != BT_CLASS) @@ -3351,7 +3350,7 @@ gfc_check_same_type_as (gfc_expr *a, gfc_expr *b) gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &a->where, gfc_typename (&a->ts)); - return FAILURE; + return false; } if (!(gfc_type_is_extensible (a->ts.u.derived) || UNLIMITED_POLY (a))) @@ -3360,7 +3359,7 @@ gfc_check_same_type_as (gfc_expr *a, gfc_expr *b) "must be of an extensible type", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &a->where); - return FAILURE; + return false; } if (b->ts.type != BT_DERIVED && b->ts.type != BT_CLASS) @@ -3370,7 +3369,7 @@ gfc_check_same_type_as (gfc_expr *a, gfc_expr *b) gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &b->where, gfc_typename (&b->ts)); - return FAILURE; + return false; } if (!(gfc_type_is_extensible (b->ts.u.derived) || UNLIMITED_POLY (b))) @@ -3379,162 +3378,162 @@ gfc_check_same_type_as (gfc_expr *a, gfc_expr *b) "must be of an extensible type", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &b->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_scale (gfc_expr *x, gfc_expr *i) { - if (type_check (x, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_REAL)) + return false; - if (type_check (i, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind) { - if (type_check (x, 0, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_CHARACTER)) + return false; - if (type_check (y, 1, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (y, 1, BT_CHARACTER)) + return false; - if (z != NULL && type_check (z, 2, BT_LOGICAL) == FAILURE) - return FAILURE; + if (z != NULL && !type_check (z, 2, BT_LOGICAL)) + return false; - if (kind_check (kind, 3, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!kind_check (kind, 3, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; - if (same_type_check (x, 0, y, 1) == FAILURE) - return FAILURE; + if (!same_type_check (x, 0, y, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_secnds (gfc_expr *r) { - if (type_check (r, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (r, 0, BT_REAL)) + return false; - if (kind_value_check (r, 0, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (r, 0, 4)) + return false; - if (scalar_check (r, 0) == FAILURE) - return FAILURE; + if (!scalar_check (r, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_selected_char_kind (gfc_expr *name) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; - if (scalar_check (name, 0) == FAILURE) - return FAILURE; + if (!scalar_check (name, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_selected_int_kind (gfc_expr *r) { - if (type_check (r, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (r, 0, BT_INTEGER)) + return false; - if (scalar_check (r, 0) == FAILURE) - return FAILURE; + if (!scalar_check (r, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix) { if (p == NULL && r == NULL - && gfc_notify_std (GFC_STD_F2008, "SELECTED_REAL_KIND with" - " neither 'P' nor 'R' argument at %L", - gfc_current_intrinsic_where) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2008, "SELECTED_REAL_KIND with" + " neither 'P' nor 'R' argument at %L", + gfc_current_intrinsic_where)) + return false; if (p) { - if (type_check (p, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (p, 0, BT_INTEGER)) + return false; - if (scalar_check (p, 0) == FAILURE) - return FAILURE; + if (!scalar_check (p, 0)) + return false; } if (r) { - if (type_check (r, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (r, 1, BT_INTEGER)) + return false; - if (scalar_check (r, 1) == FAILURE) - return FAILURE; + if (!scalar_check (r, 1)) + return false; } if (radix) { - if (type_check (radix, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (radix, 1, BT_INTEGER)) + return false; - if (scalar_check (radix, 1) == FAILURE) - return FAILURE; + if (!scalar_check (radix, 1)) + return false; - if (gfc_notify_std (GFC_STD_F2008, "'%s' intrinsic with " - "RADIX argument at %L", gfc_current_intrinsic, - &radix->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2008, "'%s' intrinsic with " + "RADIX argument at %L", gfc_current_intrinsic, + &radix->where)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_set_exponent (gfc_expr *x, gfc_expr *i) { - if (type_check (x, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_REAL)) + return false; - if (type_check (i, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_shape (gfc_expr *source, gfc_expr *kind) { gfc_array_ref *ar; if (source->rank == 0 || source->expr_type != EXPR_VARIABLE) - return SUCCESS; + return true; ar = gfc_find_array_ref (source); @@ -3542,77 +3541,77 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind) { gfc_error ("'source' argument of 'shape' intrinsic at %L must not be " "an assumed size array", &source->where); - return FAILURE; + return false; } - if (kind_check (kind, 1, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!kind_check (kind, 1, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_shift (gfc_expr *i, gfc_expr *shift) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (type_check (shift, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (shift, 0, BT_INTEGER)) + return false; - if (nonnegative_check ("SHIFT", shift) == FAILURE) - return FAILURE; + if (!nonnegative_check ("SHIFT", shift)) + return false; - if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE) - return FAILURE; + if (!less_than_bitsize1 ("I", i, "SHIFT", shift, true)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_sign (gfc_expr *a, gfc_expr *b) { - if (int_or_real_check (a, 0) == FAILURE) - return FAILURE; + if (!int_or_real_check (a, 0)) + return false; - if (same_type_check (a, 0, b, 1) == FAILURE) - return FAILURE; + if (!same_type_check (a, 0, b, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { - if (array_check (array, 0) == FAILURE) - return FAILURE; + if (!array_check (array, 0)) + return false; - if (dim_check (dim, 1, true) == FAILURE) - return FAILURE; + if (!dim_check (dim, 1, true)) + return false; - if (dim_rank_check (dim, array, 0) == FAILURE) - return FAILURE; + if (!dim_rank_check (dim, array, 0)) + return false; - if (kind_check (kind, 2, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!kind_check (kind, 2, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_sizeof (gfc_expr *arg) { if (arg->ts.type == BT_PROCEDURE) @@ -3620,7 +3619,7 @@ gfc_check_sizeof (gfc_expr *arg) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be a procedure", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &arg->where); - return FAILURE; + return false; } if (arg->ts.type == BT_ASSUMED) @@ -3628,7 +3627,7 @@ gfc_check_sizeof (gfc_expr *arg) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &arg->where); - return FAILURE; + return false; } if (arg->rank && arg->expr_type == EXPR_VARIABLE @@ -3639,10 +3638,10 @@ gfc_check_sizeof (gfc_expr *arg) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be an " "assumed-size array", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &arg->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -3704,7 +3703,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc) } if (expr->ts.u.cl && expr->ts.u.cl->length - && gfc_simplify_expr (expr, 0) == FAILURE) + && !gfc_simplify_expr (expr, 0)) gfc_internal_error ("is_c_interoperable(): gfc_simplify_expr failed"); if (!c_loc && expr->ts.u.cl @@ -3746,18 +3745,18 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc) } -gfc_try +bool gfc_check_c_sizeof (gfc_expr *arg) { const char *msg; - if (is_c_interoperable (arg, &msg, false) != SUCCESS) + if (!is_c_interoperable (arg, &msg, false)) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be an " "interoperable data entity: %s", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &arg->where, msg); - return FAILURE; + return false; } if (arg->ts.type == BT_ASSUMED) @@ -3766,7 +3765,7 @@ gfc_check_c_sizeof (gfc_expr *arg) "TYPE(*)", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &arg->where); - return FAILURE; + return false; } if (arg->rank && arg->expr_type == EXPR_VARIABLE @@ -3777,14 +3776,14 @@ gfc_check_c_sizeof (gfc_expr *arg) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be an " "assumed-size array", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &arg->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_c_associated (gfc_expr *c_ptr_1, gfc_expr *c_ptr_2) { if (c_ptr_1->ts.type != BT_DERIVED @@ -3794,11 +3793,11 @@ gfc_check_c_associated (gfc_expr *c_ptr_1, gfc_expr *c_ptr_2) { gfc_error ("Argument C_PTR_1 at %L to C_ASSOCIATED shall have the " "type TYPE(C_PTR) or TYPE(C_FUNPTR)", &c_ptr_1->where); - return FAILURE; + return false; } - if (scalar_check (c_ptr_1, 0) == FAILURE) - return FAILURE; + if (!scalar_check (c_ptr_1, 0)) + return false; if (c_ptr_2 && (c_ptr_2->ts.type != BT_DERIVED @@ -3810,17 +3809,17 @@ gfc_check_c_associated (gfc_expr *c_ptr_1, gfc_expr *c_ptr_2) "same type as C_PTR_1: %s instead of %s", &c_ptr_1->where, gfc_typename (&c_ptr_1->ts), gfc_typename (&c_ptr_2->ts)); - return FAILURE; + return false; } - if (c_ptr_2 && scalar_check (c_ptr_2, 1) == FAILURE) - return FAILURE; + if (c_ptr_2 && !scalar_check (c_ptr_2, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape) { symbol_attribute attr; @@ -3832,11 +3831,11 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape) { gfc_error ("Argument CPTR at %L to C_F_POINTER shall have the " "type TYPE(C_PTR)", &cptr->where); - return FAILURE; + return false; } - if (scalar_check (cptr, 0) == FAILURE) - return FAILURE; + if (!scalar_check (cptr, 0)) + return false; attr = gfc_expr_attr (fptr); @@ -3844,53 +3843,53 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape) { gfc_error ("Argument FPTR at %L to C_F_POINTER must be a pointer", &fptr->where); - return FAILURE; + return false; } if (fptr->ts.type == BT_CLASS) { gfc_error ("FPTR argument at %L to C_F_POINTER shall not be polymorphic", &fptr->where); - return FAILURE; + return false; } if (gfc_is_coindexed (fptr)) { gfc_error ("Argument FPTR at %L to C_F_POINTER shall not be " "coindexed", &fptr->where); - return FAILURE; + return false; } if (fptr->rank == 0 && shape) { gfc_error ("Unexpected SHAPE argument at %L to C_F_POINTER with scalar " "FPTR", &fptr->where); - return FAILURE; + return false; } else if (fptr->rank && !shape) { gfc_error ("Expected SHAPE argument to C_F_POINTER with array " "FPTR at %L", &fptr->where); - return FAILURE; + return false; } - if (shape && rank_check (shape, 2, 1) == FAILURE) - return FAILURE; + if (shape && !rank_check (shape, 2, 1)) + return false; - if (shape && type_check (shape, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (shape && !type_check (shape, 2, BT_INTEGER)) + return false; if (shape) { mpz_t size; - if (gfc_array_size (shape, &size) == SUCCESS + if (gfc_array_size (shape, &size) && mpz_cmp_ui (size, fptr->rank) != 0) { mpz_clear (size); gfc_error ("SHAPE argument at %L to C_F_POINTER must have the same " "size as the RANK of FPTR", &shape->where); - return FAILURE; + return false; } mpz_clear (size); } @@ -3898,18 +3897,18 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape) if (fptr->ts.type == BT_CLASS) { gfc_error ("Polymorphic FPTR at %L to C_F_POINTER", &fptr->where); - return FAILURE; + return false; } if (!is_c_interoperable (fptr, &msg, false) && fptr->rank) return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array FPTR " "at %L to C_F_POINTER: %s", &fptr->where, msg); - return SUCCESS; + return true; } -gfc_try +bool gfc_check_c_f_procpointer (gfc_expr *cptr, gfc_expr *fptr) { symbol_attribute attr; @@ -3920,11 +3919,11 @@ gfc_check_c_f_procpointer (gfc_expr *cptr, gfc_expr *fptr) { gfc_error ("Argument CPTR at %L to C_F_PROCPOINTER shall have the " "type TYPE(C_FUNPTR)", &cptr->where); - return FAILURE; + return false; } - if (scalar_check (cptr, 0) == FAILURE) - return FAILURE; + if (!scalar_check (cptr, 0)) + return false; attr = gfc_expr_attr (fptr); @@ -3932,25 +3931,25 @@ gfc_check_c_f_procpointer (gfc_expr *cptr, gfc_expr *fptr) { gfc_error ("Argument FPTR at %L to C_F_PROCPOINTER shall be a procedure " "pointer", &fptr->where); - return FAILURE; + return false; } if (gfc_is_coindexed (fptr)) { gfc_error ("Argument FPTR at %L to C_F_PROCPOINTER shall not be " "coindexed", &fptr->where); - return FAILURE; + return false; } if (!attr.is_bind_c) return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable procedure " "pointer at %L to C_F_PROCPOINTER", &fptr->where); - return SUCCESS; + return true; } -gfc_try +bool gfc_check_c_funloc (gfc_expr *x) { symbol_attribute attr; @@ -3959,7 +3958,7 @@ gfc_check_c_funloc (gfc_expr *x) { gfc_error ("Argument X at %L to C_FUNLOC shall not be " "coindexed", &x->where); - return FAILURE; + return false; } attr = gfc_expr_attr (x); @@ -3974,7 +3973,7 @@ gfc_check_c_funloc (gfc_expr *x) { gfc_error ("Function result '%s' at %L is invalid as X argument " "to C_FUNLOC", x->symtree->n.sym->name, &x->where); - return FAILURE; + return false; } } @@ -3982,17 +3981,17 @@ gfc_check_c_funloc (gfc_expr *x) { gfc_error ("Argument X at %L to C_FUNLOC shall be a procedure " "or a procedure pointer", &x->where); - return FAILURE; + return false; } if (!attr.is_bind_c) return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable procedure " "at %L to C_FUNLOC", &x->where); - return SUCCESS; + return true; } -gfc_try +bool gfc_check_c_loc (gfc_expr *x) { symbol_attribute attr; @@ -4001,14 +4000,14 @@ gfc_check_c_loc (gfc_expr *x) if (gfc_is_coindexed (x)) { gfc_error ("Argument X at %L to C_LOC shall not be coindexed", &x->where); - return FAILURE; + return false; } if (x->ts.type == BT_CLASS) { gfc_error ("X argument at %L to C_LOC shall not be polymorphic", &x->where); - return FAILURE; + return false; } attr = gfc_expr_attr (x); @@ -4019,7 +4018,7 @@ gfc_check_c_loc (gfc_expr *x) { gfc_error ("Argument X at %L to C_LOC shall have either " "the POINTER or the TARGET attribute", &x->where); - return FAILURE; + return false; } if (x->ts.type == BT_CHARACTER @@ -4027,7 +4026,7 @@ gfc_check_c_loc (gfc_expr *x) { gfc_error ("Argument X at %L to C_LOC shall be not be a zero-sized " "string", &x->where); - return FAILURE; + return false; } if (!is_c_interoperable (x, &msg, true)) @@ -4036,13 +4035,14 @@ gfc_check_c_loc (gfc_expr *x) { gfc_error ("Argument at %L to C_LOC shall not be polymorphic", &x->where); - return FAILURE; + return false; } if (x->rank - && gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array at %L as" - " argument to C_LOC: %s", &x->where, msg) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2008_TS, + "Noninteroperable array at %L as" + " argument to C_LOC: %s", &x->where, msg)) + return false; } else if (x->rank > 0 && gfc_notification_std (GFC_STD_F2008)) { @@ -4050,49 +4050,49 @@ gfc_check_c_loc (gfc_expr *x) if (ar->as->type != AS_EXPLICIT && ar->as->type != AS_ASSUMED_SIZE && !attr.allocatable - && gfc_notify_std (GFC_STD_F2008, "Array of interoperable type at %L " - "to C_LOC which is nonallocatable and neither " - "assumed size nor explicit size", &x->where) - == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2008, + "Array of interoperable type at %L " + "to C_LOC which is nonallocatable and neither " + "assumed size nor explicit size", &x->where)) + return false; else if (ar->type != AR_FULL - && gfc_notify_std (GFC_STD_F2008, "Array section at %L " - "to C_LOC", &x->where) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2008, "Array section at %L " + "to C_LOC", &x->where)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_sleep_sub (gfc_expr *seconds) { - if (type_check (seconds, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (seconds, 0, BT_INTEGER)) + return false; - if (scalar_check (seconds, 0) == FAILURE) - return FAILURE; + if (!scalar_check (seconds, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_sngl (gfc_expr *a) { - if (type_check (a, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (a, 0, BT_REAL)) + return false; if ((a->ts.kind != gfc_default_double_kind) - && gfc_notify_std (GFC_STD_GNU, "non double precision " - "REAL argument to %s intrinsic at %L", - gfc_current_intrinsic, &a->where) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_GNU, "non double precision " + "REAL argument to %s intrinsic at %L", + gfc_current_intrinsic, &a->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies) { if (source->rank >= GFC_MAX_DIMENSIONS) @@ -4101,14 +4101,14 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies) "than rank %d", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &source->where, GFC_MAX_DIMENSIONS); - return FAILURE; + return false; } if (dim == NULL) - return FAILURE; + return false; - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (dim, 1, false)) + return false; /* dim_rank_check() does not apply here. */ if (dim @@ -4119,251 +4119,251 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies) gfc_error ("'%s' argument of '%s' intrinsic at %L is not a valid " "dimension index", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &dim->where); - return FAILURE; + return false; } - if (type_check (ncopies, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (ncopies, 2, BT_INTEGER)) + return false; - if (scalar_check (ncopies, 2) == FAILURE) - return FAILURE; + if (!scalar_check (ncopies, 2)) + return false; - return SUCCESS; + return true; } /* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and functions). */ -gfc_try +bool gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status) { - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - if (type_check (c, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (c, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (c, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (c, 1, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE - || kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE - || scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER) + || !kind_value_check (status, 2, gfc_default_integer_kind) + || !scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_fgetputc (gfc_expr *unit, gfc_expr *c) { return gfc_check_fgetputc_sub (unit, c, NULL); } -gfc_try +bool gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status) { - if (type_check (c, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (c, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (c, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (c, 0, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 1, BT_INTEGER) == FAILURE - || kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE - || scalar_check (status, 1) == FAILURE) - return FAILURE; + if (!type_check (status, 1, BT_INTEGER) + || !kind_value_check (status, 1, gfc_default_integer_kind) + || !scalar_check (status, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_fgetput (gfc_expr *c) { return gfc_check_fgetput_sub (c, NULL); } -gfc_try +bool gfc_check_fseek_sub (gfc_expr *unit, gfc_expr *offset, gfc_expr *whence, gfc_expr *status) { - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - if (type_check (offset, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (offset, 1, BT_INTEGER)) + return false; - if (scalar_check (offset, 1) == FAILURE) - return FAILURE; + if (!scalar_check (offset, 1)) + return false; - if (type_check (whence, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (whence, 2, BT_INTEGER)) + return false; - if (scalar_check (whence, 2) == FAILURE) - return FAILURE; + if (!scalar_check (whence, 2)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 3, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 3, BT_INTEGER)) + return false; - if (kind_value_check (status, 3, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (status, 3, 4)) + return false; - if (scalar_check (status, 3) == FAILURE) - return FAILURE; + if (!scalar_check (status, 3)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_fstat (gfc_expr *unit, gfc_expr *array) { - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - if (type_check (array, 1, BT_INTEGER) == FAILURE - || kind_value_check (unit, 0, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!type_check (array, 1, BT_INTEGER) + || !kind_value_check (unit, 0, gfc_default_integer_kind)) + return false; - if (array_check (array, 1) == FAILURE) - return FAILURE; + if (!array_check (array, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *array, gfc_expr *status) { - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - if (type_check (array, 1, BT_INTEGER) == FAILURE - || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!type_check (array, 1, BT_INTEGER) + || !kind_value_check (array, 1, gfc_default_integer_kind)) + return false; - if (array_check (array, 1) == FAILURE) - return FAILURE; + if (!array_check (array, 1)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE - || kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER) + || !kind_value_check (status, 2, gfc_default_integer_kind)) + return false; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ftell (gfc_expr *unit) { - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ftell_sub (gfc_expr *unit, gfc_expr *offset) { - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - if (type_check (offset, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (offset, 1, BT_INTEGER)) + return false; - if (scalar_check (offset, 1) == FAILURE) - return FAILURE; + if (!scalar_check (offset, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_stat (gfc_expr *name, gfc_expr *array) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; - if (type_check (array, 1, BT_INTEGER) == FAILURE - || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!type_check (array, 1, BT_INTEGER) + || !kind_value_check (array, 1, gfc_default_integer_kind)) + return false; - if (array_check (array, 1) == FAILURE) - return FAILURE; + if (!array_check (array, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; - if (type_check (array, 1, BT_INTEGER) == FAILURE - || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!type_check (array, 1, BT_INTEGER) + || !kind_value_check (array, 1, gfc_default_integer_kind)) + return false; - if (array_check (array, 1) == FAILURE) - return FAILURE; + if (!array_check (array, 1)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE - || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER) + || !kind_value_check (array, 1, gfc_default_integer_kind)) + return false; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub) { mpz_t nelems; @@ -4371,20 +4371,20 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub) if (gfc_option.coarray == GFC_FCOARRAY_NONE) { gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable"); - return FAILURE; + return false; } - if (coarray_check (coarray, 0) == FAILURE) - return FAILURE; + if (!coarray_check (coarray, 0)) + return false; if (sub->rank != 1) { gfc_error ("%s argument to IMAGE_INDEX must be a rank one array at %L", gfc_current_intrinsic_arg[1]->name, &sub->where); - return FAILURE; + return false; } - if (gfc_array_size (sub, &nelems) == SUCCESS) + if (gfc_array_size (sub, &nelems)) { int corank = gfc_get_corank (coarray); @@ -4394,53 +4394,53 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub) "IMAGE_INDEX at %L shall be %d (corank) not %d", &sub->where, corank, (int) mpz_get_si (nelems)); mpz_clear (nelems); - return FAILURE; + return false; } mpz_clear (nelems); } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_this_image (gfc_expr *coarray, gfc_expr *dim) { if (gfc_option.coarray == GFC_FCOARRAY_NONE) { gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable"); - return FAILURE; + return false; } if (dim != NULL && coarray == NULL) { gfc_error ("DIM argument without ARRAY argument not allowed for THIS_IMAGE " "intrinsic at %L", &dim->where); - return FAILURE; + return false; } if (coarray == NULL) - return SUCCESS; + return true; - if (coarray_check (coarray, 0) == FAILURE) - return FAILURE; + if (!coarray_check (coarray, 0)) + return false; if (dim != NULL) { - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (dim, 1, false)) + return false; - if (dim_corank_check (dim, coarray) == FAILURE) - return FAILURE; + if (!dim_corank_check (dim, coarray)) + return false; } - return SUCCESS; + return true; } /* Calculate the sizes for transfer, used by gfc_check_transfer and also - by gfc_simplify_transfer. Return FAILURE if we cannot do so. */ + by gfc_simplify_transfer. Return false if we cannot do so. */ -gfc_try +bool gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, size_t *source_size, size_t *result_size, size_t *result_length_p) @@ -4450,19 +4450,19 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, gfc_expr *mold_element; if (source->expr_type == EXPR_FUNCTION) - return FAILURE; + return false; if (size && size->expr_type != EXPR_CONSTANT) - return FAILURE; + return false; /* Calculate the size of the source. */ if (source->expr_type == EXPR_ARRAY - && gfc_array_size (source, &tmp) == FAILURE) - return FAILURE; + && !gfc_array_size (source, &tmp)) + return false; *source_size = gfc_target_expr_size (source); if (*source_size == 0) - return FAILURE; + return false; mold_element = mold->expr_type == EXPR_ARRAY ? gfc_constructor_first (mold->value.constructor)->expr @@ -4471,7 +4471,7 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, /* Determine the size of the element. */ result_elt_size = gfc_target_expr_size (mold_element); if (result_elt_size == 0) - return FAILURE; + return false; if (mold->expr_type == EXPR_ARRAY || mold->rank || size) { @@ -4493,11 +4493,11 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, else *result_size = result_elt_size; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) { size_t source_size; @@ -4507,120 +4507,120 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) { gfc_error ("'MOLD' argument of 'TRANSFER' intrinsic at %L must not be %s", &mold->where, gfc_basic_typename (BT_HOLLERITH)); - return FAILURE; + return false; } if (size != NULL) { - if (type_check (size, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (size, 2, BT_INTEGER)) + return false; - if (scalar_check (size, 2) == FAILURE) - return FAILURE; + if (!scalar_check (size, 2)) + return false; - if (nonoptional_check (size, 2) == FAILURE) - return FAILURE; + if (!nonoptional_check (size, 2)) + return false; } if (!gfc_option.warn_surprising) - return SUCCESS; + return true; /* If we can't calculate the sizes, we cannot check any more. - Return SUCCESS for that case. */ + Return true for that case. */ - if (gfc_calculate_transfer_sizes (source, mold, size, &source_size, - &result_size, NULL) == FAILURE) - return SUCCESS; + if (!gfc_calculate_transfer_sizes (source, mold, size, &source_size, + &result_size, NULL)) + return true; if (source_size < result_size) gfc_warning("Intrinsic TRANSFER at %L has partly undefined result: " "source size %ld < result size %ld", &source->where, (long) source_size, (long) result_size); - return SUCCESS; + return true; } -gfc_try +bool gfc_check_transpose (gfc_expr *matrix) { - if (rank_check (matrix, 0, 2) == FAILURE) - return FAILURE; + if (!rank_check (matrix, 0, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { - if (array_check (array, 0) == FAILURE) - return FAILURE; + if (!array_check (array, 0)) + return false; - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (dim, 1, false)) + return false; - if (dim_rank_check (dim, array, 0) == FAILURE) - return FAILURE; + if (!dim_rank_check (dim, array, 0)) + return false; - if (kind_check (kind, 2, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!kind_check (kind, 2, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ucobound (gfc_expr *coarray, gfc_expr *dim, gfc_expr *kind) { if (gfc_option.coarray == GFC_FCOARRAY_NONE) { gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable"); - return FAILURE; + return false; } - if (coarray_check (coarray, 0) == FAILURE) - return FAILURE; + if (!coarray_check (coarray, 0)) + return false; if (dim != NULL) { - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (!dim_check (dim, 1, false)) + return false; - if (dim_corank_check (dim, coarray) == FAILURE) - return FAILURE; + if (!dim_corank_check (dim, coarray)) + return false; } - if (kind_check (kind, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!kind_check (kind, 2, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field) { mpz_t vector_size; - if (rank_check (vector, 0, 1) == FAILURE) - return FAILURE; + if (!rank_check (vector, 0, 1)) + return false; - if (array_check (mask, 1) == FAILURE) - return FAILURE; + if (!array_check (mask, 1)) + return false; - if (type_check (mask, 1, BT_LOGICAL) == FAILURE) - return FAILURE; + if (!type_check (mask, 1, BT_LOGICAL)) + return false; - if (same_type_check (vector, 0, field, 2) == FAILURE) - return FAILURE; + if (!same_type_check (vector, 0, field, 2)) + return false; if (mask->expr_type == EXPR_ARRAY - && gfc_array_size (vector, &vector_size) == SUCCESS) + && gfc_array_size (vector, &vector_size)) { int mask_true_count = 0; gfc_constructor *mask_ctor; @@ -4647,7 +4647,7 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field) gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &vector->where, gfc_current_intrinsic_arg[1]->name, mpz_get_si (vector_size), mask_true_count); - return FAILURE; + return false; } mpz_clear (vector_size); @@ -4659,7 +4659,7 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field) "the same rank as '%s' or be a scalar", gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic, &field->where, gfc_current_intrinsic_arg[1]->name); - return FAILURE; + return false; } if (mask->rank == field->rank) @@ -4676,202 +4676,201 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field) } } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind) { - if (type_check (x, 0, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_CHARACTER)) + return false; - if (same_type_check (x, 0, y, 1) == FAILURE) - return FAILURE; + if (!same_type_check (x, 0, y, 1)) + return false; - if (z != NULL && type_check (z, 2, BT_LOGICAL) == FAILURE) - return FAILURE; + if (z != NULL && !type_check (z, 2, BT_LOGICAL)) + return false; - if (kind_check (kind, 3, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " - "with KIND argument at %L", - gfc_current_intrinsic, &kind->where) == FAILURE) - return FAILURE; + if (!kind_check (kind, 3, BT_INTEGER)) + return false; + if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic " + "with KIND argument at %L", + gfc_current_intrinsic, &kind->where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_trim (gfc_expr *x) { - if (type_check (x, 0, BT_CHARACTER) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_CHARACTER)) + return false; - if (scalar_check (x, 0) == FAILURE) - return FAILURE; + if (!scalar_check (x, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ttynam (gfc_expr *unit) { - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - return SUCCESS; + return true; } /* Common check function for the half a dozen intrinsics that have a single real argument. */ -gfc_try +bool gfc_check_x (gfc_expr *x) { - if (type_check (x, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_REAL)) + return false; - return SUCCESS; + return true; } /************* Check functions for intrinsic subroutines *************/ -gfc_try +bool gfc_check_cpu_time (gfc_expr *time) { - if (scalar_check (time, 0) == FAILURE) - return FAILURE; + if (!scalar_check (time, 0)) + return false; - if (type_check (time, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (time, 0, BT_REAL)) + return false; - if (variable_check (time, 0, false) == FAILURE) - return FAILURE; + if (!variable_check (time, 0, false)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_date_and_time (gfc_expr *date, gfc_expr *time, gfc_expr *zone, gfc_expr *values) { if (date != NULL) { - if (type_check (date, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (date, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; - if (scalar_check (date, 0) == FAILURE) - return FAILURE; - if (variable_check (date, 0, false) == FAILURE) - return FAILURE; + if (!type_check (date, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (date, 0, gfc_default_character_kind)) + return false; + if (!scalar_check (date, 0)) + return false; + if (!variable_check (date, 0, false)) + return false; } if (time != NULL) { - if (type_check (time, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (time, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; - if (scalar_check (time, 1) == FAILURE) - return FAILURE; - if (variable_check (time, 1, false) == FAILURE) - return FAILURE; + if (!type_check (time, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (time, 1, gfc_default_character_kind)) + return false; + if (!scalar_check (time, 1)) + return false; + if (!variable_check (time, 1, false)) + return false; } if (zone != NULL) { - if (type_check (zone, 2, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (zone, 2, gfc_default_character_kind) == FAILURE) - return FAILURE; - if (scalar_check (zone, 2) == FAILURE) - return FAILURE; - if (variable_check (zone, 2, false) == FAILURE) - return FAILURE; + if (!type_check (zone, 2, BT_CHARACTER)) + return false; + if (!kind_value_check (zone, 2, gfc_default_character_kind)) + return false; + if (!scalar_check (zone, 2)) + return false; + if (!variable_check (zone, 2, false)) + return false; } if (values != NULL) { - if (type_check (values, 3, BT_INTEGER) == FAILURE) - return FAILURE; - if (array_check (values, 3) == FAILURE) - return FAILURE; - if (rank_check (values, 3, 1) == FAILURE) - return FAILURE; - if (variable_check (values, 3, false) == FAILURE) - return FAILURE; + if (!type_check (values, 3, BT_INTEGER)) + return false; + if (!array_check (values, 3)) + return false; + if (!rank_check (values, 3, 1)) + return false; + if (!variable_check (values, 3, false)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len, gfc_expr *to, gfc_expr *topos) { - if (type_check (from, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (from, 0, BT_INTEGER)) + return false; - if (type_check (frompos, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (frompos, 1, BT_INTEGER)) + return false; - if (type_check (len, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (len, 2, BT_INTEGER)) + return false; - if (same_type_check (from, 0, to, 3) == FAILURE) - return FAILURE; + if (!same_type_check (from, 0, to, 3)) + return false; - if (variable_check (to, 3, false) == FAILURE) - return FAILURE; + if (!variable_check (to, 3, false)) + return false; - if (type_check (topos, 4, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (topos, 4, BT_INTEGER)) + return false; - if (nonnegative_check ("frompos", frompos) == FAILURE) - return FAILURE; + if (!nonnegative_check ("frompos", frompos)) + return false; - if (nonnegative_check ("topos", topos) == FAILURE) - return FAILURE; + if (!nonnegative_check ("topos", topos)) + return false; - if (nonnegative_check ("len", len) == FAILURE) - return FAILURE; + if (!nonnegative_check ("len", len)) + return false; - if (less_than_bitsize2 ("from", from, "frompos", frompos, "len", len) - == FAILURE) - return FAILURE; + if (!less_than_bitsize2 ("from", from, "frompos", frompos, "len", len)) + return false; - if (less_than_bitsize2 ("to", to, "topos", topos, "len", len) == FAILURE) - return FAILURE; + if (!less_than_bitsize2 ("to", to, "topos", topos, "len", len)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_random_number (gfc_expr *harvest) { - if (type_check (harvest, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (harvest, 0, BT_REAL)) + return false; - if (variable_check (harvest, 0, false) == FAILURE) - return FAILURE; + if (!variable_check (harvest, 0, false)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) { unsigned int nargs = 0, kiss_size; @@ -4891,17 +4890,17 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) || !size->symtree->n.sym->attr.optional) nargs++; - if (scalar_check (size, 0) == FAILURE) - return FAILURE; + if (!scalar_check (size, 0)) + return false; - if (type_check (size, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (size, 0, BT_INTEGER)) + return false; - if (variable_check (size, 0, false) == FAILURE) - return FAILURE; + if (!variable_check (size, 0, false)) + return false; - if (kind_value_check (size, 0, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!kind_value_check (size, 0, gfc_default_integer_kind)) + return false; } if (put != NULL) @@ -4913,19 +4912,19 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) where = &put->where; } - if (array_check (put, 1) == FAILURE) - return FAILURE; + if (!array_check (put, 1)) + return false; - if (rank_check (put, 1, 1) == FAILURE) - return FAILURE; + if (!rank_check (put, 1, 1)) + return false; - if (type_check (put, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (put, 1, BT_INTEGER)) + return false; - if (kind_value_check (put, 1, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!kind_value_check (put, 1, gfc_default_integer_kind)) + return false; - if (gfc_array_size (put, &put_size) == SUCCESS + if (gfc_array_size (put, &put_size) && mpz_get_ui (put_size) < kiss_size) gfc_error ("Size of '%s' argument of '%s' intrinsic at %L " "too small (%i/%i)", @@ -4942,22 +4941,22 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) where = &get->where; } - if (array_check (get, 2) == FAILURE) - return FAILURE; + if (!array_check (get, 2)) + return false; - if (rank_check (get, 2, 1) == FAILURE) - return FAILURE; + if (!rank_check (get, 2, 1)) + return false; - if (type_check (get, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (get, 2, BT_INTEGER)) + return false; - if (variable_check (get, 2, false) == FAILURE) - return FAILURE; + if (!variable_check (get, 2, false)) + return false; - if (kind_value_check (get, 2, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!kind_value_check (get, 2, gfc_default_integer_kind)) + return false; - if (gfc_array_size (get, &get_size) == SUCCESS + if (gfc_array_size (get, &get_size) && mpz_get_ui (get_size) < kiss_size) gfc_error ("Size of '%s' argument of '%s' intrinsic at %L " "too small (%i/%i)", @@ -4969,287 +4968,287 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) if (nargs > 1) gfc_error ("Too many arguments to %s at %L", gfc_current_intrinsic, where); - return SUCCESS; + return true; } -gfc_try +bool gfc_check_second_sub (gfc_expr *time) { - if (scalar_check (time, 0) == FAILURE) - return FAILURE; + if (!scalar_check (time, 0)) + return false; - if (type_check (time, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (time, 0, BT_REAL)) + return false; - if (kind_value_check(time, 0, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (time, 0, 4)) + return false; - return SUCCESS; + return true; } /* The arguments of SYSTEM_CLOCK are scalar, integer variables. Note, count, count_rate, and count_max are all optional arguments */ -gfc_try +bool gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate, gfc_expr *count_max) { if (count != NULL) { - if (scalar_check (count, 0) == FAILURE) - return FAILURE; + if (!scalar_check (count, 0)) + return false; - if (type_check (count, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (count, 0, BT_INTEGER)) + return false; - if (variable_check (count, 0, false) == FAILURE) - return FAILURE; + if (!variable_check (count, 0, false)) + return false; } if (count_rate != NULL) { - if (scalar_check (count_rate, 1) == FAILURE) - return FAILURE; + if (!scalar_check (count_rate, 1)) + return false; - if (type_check (count_rate, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (count_rate, 1, BT_INTEGER)) + return false; - if (variable_check (count_rate, 1, false) == FAILURE) - return FAILURE; + if (!variable_check (count_rate, 1, false)) + return false; if (count != NULL - && same_type_check (count, 0, count_rate, 1) == FAILURE) - return FAILURE; + && !same_type_check (count, 0, count_rate, 1)) + return false; } if (count_max != NULL) { - if (scalar_check (count_max, 2) == FAILURE) - return FAILURE; + if (!scalar_check (count_max, 2)) + return false; - if (type_check (count_max, 2, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (count_max, 2, BT_INTEGER)) + return false; - if (variable_check (count_max, 2, false) == FAILURE) - return FAILURE; + if (!variable_check (count_max, 2, false)) + return false; if (count != NULL - && same_type_check (count, 0, count_max, 2) == FAILURE) - return FAILURE; + && !same_type_check (count, 0, count_max, 2)) + return false; if (count_rate != NULL - && same_type_check (count_rate, 1, count_max, 2) == FAILURE) - return FAILURE; + && !same_type_check (count_rate, 1, count_max, 2)) + return false; } - return SUCCESS; + return true; } -gfc_try +bool gfc_check_irand (gfc_expr *x) { if (x == NULL) - return SUCCESS; + return true; - if (scalar_check (x, 0) == FAILURE) - return FAILURE; + if (!scalar_check (x, 0)) + return false; - if (type_check (x, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_INTEGER)) + return false; - if (kind_value_check(x, 0, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (x, 0, 4)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_alarm_sub (gfc_expr *seconds, gfc_expr *handler, gfc_expr *status) { - if (scalar_check (seconds, 0) == FAILURE) - return FAILURE; - if (type_check (seconds, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!scalar_check (seconds, 0)) + return false; + if (!type_check (seconds, 0, BT_INTEGER)) + return false; - if (int_or_proc_check (handler, 1) == FAILURE) - return FAILURE; - if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE) - return FAILURE; + if (!int_or_proc_check (handler, 1)) + return false; + if (handler->ts.type == BT_INTEGER && !scalar_check (handler, 1)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; - if (type_check (status, 2, BT_INTEGER) == FAILURE) - return FAILURE; - if (kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!scalar_check (status, 2)) + return false; + if (!type_check (status, 2, BT_INTEGER)) + return false; + if (!kind_value_check (status, 2, gfc_default_integer_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_rand (gfc_expr *x) { if (x == NULL) - return SUCCESS; + return true; - if (scalar_check (x, 0) == FAILURE) - return FAILURE; + if (!scalar_check (x, 0)) + return false; - if (type_check (x, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_INTEGER)) + return false; - if (kind_value_check(x, 0, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (x, 0, 4)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_srand (gfc_expr *x) { - if (scalar_check (x, 0) == FAILURE) - return FAILURE; + if (!scalar_check (x, 0)) + return false; - if (type_check (x, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_INTEGER)) + return false; - if (kind_value_check(x, 0, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (x, 0, 4)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ctime_sub (gfc_expr *time, gfc_expr *result) { - if (scalar_check (time, 0) == FAILURE) - return FAILURE; - if (type_check (time, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!scalar_check (time, 0)) + return false; + if (!type_check (time, 0, BT_INTEGER)) + return false; - if (type_check (result, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (result, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (result, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (result, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_dtime_etime (gfc_expr *x) { - if (array_check (x, 0) == FAILURE) - return FAILURE; + if (!array_check (x, 0)) + return false; - if (rank_check (x, 0, 1) == FAILURE) - return FAILURE; + if (!rank_check (x, 0, 1)) + return false; - if (variable_check (x, 0, false) == FAILURE) - return FAILURE; + if (!variable_check (x, 0, false)) + return false; - if (type_check (x, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_REAL)) + return false; - if (kind_value_check(x, 0, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (x, 0, 4)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_dtime_etime_sub (gfc_expr *values, gfc_expr *time) { - if (array_check (values, 0) == FAILURE) - return FAILURE; + if (!array_check (values, 0)) + return false; - if (rank_check (values, 0, 1) == FAILURE) - return FAILURE; + if (!rank_check (values, 0, 1)) + return false; - if (variable_check (values, 0, false) == FAILURE) - return FAILURE; + if (!variable_check (values, 0, false)) + return false; - if (type_check (values, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (values, 0, BT_REAL)) + return false; - if (kind_value_check(values, 0, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (values, 0, 4)) + return false; - if (scalar_check (time, 1) == FAILURE) - return FAILURE; + if (!scalar_check (time, 1)) + return false; - if (type_check (time, 1, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (time, 1, BT_REAL)) + return false; - if (kind_value_check(time, 1, 4) == FAILURE) - return FAILURE; + if (!kind_value_check (time, 1, 4)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_fdate_sub (gfc_expr *date) { - if (type_check (date, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (date, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (date, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (date, 0, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_gerror (gfc_expr *msg) { - if (type_check (msg, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (msg, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (msg, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (msg, 0, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_getcwd_sub (gfc_expr *cwd, gfc_expr *status) { - if (type_check (cwd, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (cwd, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (cwd, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (cwd, 0, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (scalar_check (status, 1) == FAILURE) - return FAILURE; + if (!scalar_check (status, 1)) + return false; - if (type_check (status, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_getarg (gfc_expr *pos, gfc_expr *value) { - if (type_check (pos, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (pos, 0, BT_INTEGER)) + return false; if (pos->ts.kind > gfc_default_integer_kind) { @@ -5257,350 +5256,350 @@ gfc_check_getarg (gfc_expr *pos, gfc_expr *value) "not wider than the default kind (%d)", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &pos->where, gfc_default_integer_kind); - return FAILURE; + return false; } - if (type_check (value, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (value, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (value, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (value, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_getlog (gfc_expr *msg) { - if (type_check (msg, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (msg, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (msg, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (msg, 0, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_exit (gfc_expr *status) { if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 0, BT_INTEGER)) + return false; - if (scalar_check (status, 0) == FAILURE) - return FAILURE; + if (!scalar_check (status, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_flush (gfc_expr *unit) { if (unit == NULL) - return SUCCESS; + return true; - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_free (gfc_expr *i) { - if (type_check (i, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (i, 0, BT_INTEGER)) + return false; - if (scalar_check (i, 0) == FAILURE) - return FAILURE; + if (!scalar_check (i, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_hostnm (gfc_expr *name) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_hostnm_sub (gfc_expr *name, gfc_expr *status) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (scalar_check (status, 1) == FAILURE) - return FAILURE; + if (!scalar_check (status, 1)) + return false; - if (type_check (status, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_itime_idate (gfc_expr *values) { - if (array_check (values, 0) == FAILURE) - return FAILURE; + if (!array_check (values, 0)) + return false; - if (rank_check (values, 0, 1) == FAILURE) - return FAILURE; + if (!rank_check (values, 0, 1)) + return false; - if (variable_check (values, 0, false) == FAILURE) - return FAILURE; + if (!variable_check (values, 0, false)) + return false; - if (type_check (values, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (values, 0, BT_INTEGER)) + return false; - if (kind_value_check(values, 0, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!kind_value_check (values, 0, gfc_default_integer_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ltime_gmtime (gfc_expr *time, gfc_expr *values) { - if (type_check (time, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (time, 0, BT_INTEGER)) + return false; - if (kind_value_check(time, 0, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!kind_value_check (time, 0, gfc_default_integer_kind)) + return false; - if (scalar_check (time, 0) == FAILURE) - return FAILURE; + if (!scalar_check (time, 0)) + return false; - if (array_check (values, 1) == FAILURE) - return FAILURE; + if (!array_check (values, 1)) + return false; - if (rank_check (values, 1, 1) == FAILURE) - return FAILURE; + if (!rank_check (values, 1, 1)) + return false; - if (variable_check (values, 1, false) == FAILURE) - return FAILURE; + if (!variable_check (values, 1, false)) + return false; - if (type_check (values, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (values, 1, BT_INTEGER)) + return false; - if (kind_value_check(values, 1, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!kind_value_check (values, 1, gfc_default_integer_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_ttynam_sub (gfc_expr *unit, gfc_expr *name) { - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (type_check (name, 1, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 1, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 1, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 1, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_isatty (gfc_expr *unit) { if (unit == NULL) - return FAILURE; + return false; - if (type_check (unit, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (unit, 0, BT_INTEGER)) + return false; - if (scalar_check (unit, 0) == FAILURE) - return FAILURE; + if (!scalar_check (unit, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_isnan (gfc_expr *x) { - if (type_check (x, 0, BT_REAL) == FAILURE) - return FAILURE; + if (!type_check (x, 0, BT_REAL)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_perror (gfc_expr *string) { - if (type_check (string, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (string, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (string, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (string, 0, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_umask (gfc_expr *mask) { - if (type_check (mask, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (mask, 0, BT_INTEGER)) + return false; - if (scalar_check (mask, 0) == FAILURE) - return FAILURE; + if (!scalar_check (mask, 0)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_umask_sub (gfc_expr *mask, gfc_expr *old) { - if (type_check (mask, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (mask, 0, BT_INTEGER)) + return false; - if (scalar_check (mask, 0) == FAILURE) - return FAILURE; + if (!scalar_check (mask, 0)) + return false; if (old == NULL) - return SUCCESS; + return true; - if (scalar_check (old, 1) == FAILURE) - return FAILURE; + if (!scalar_check (old, 1)) + return false; - if (type_check (old, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (old, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_unlink (gfc_expr *name) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_unlink_sub (gfc_expr *name, gfc_expr *status) { - if (type_check (name, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (name, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (name, 0, gfc_default_character_kind)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (scalar_check (status, 1) == FAILURE) - return FAILURE; + if (!scalar_check (status, 1)) + return false; - if (type_check (status, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 1, BT_INTEGER)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_signal (gfc_expr *number, gfc_expr *handler) { - if (scalar_check (number, 0) == FAILURE) - return FAILURE; - if (type_check (number, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!scalar_check (number, 0)) + return false; + if (!type_check (number, 0, BT_INTEGER)) + return false; - if (int_or_proc_check (handler, 1) == FAILURE) - return FAILURE; - if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE) - return FAILURE; + if (!int_or_proc_check (handler, 1)) + return false; + if (handler->ts.type == BT_INTEGER && !scalar_check (handler, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_signal_sub (gfc_expr *number, gfc_expr *handler, gfc_expr *status) { - if (scalar_check (number, 0) == FAILURE) - return FAILURE; - if (type_check (number, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (!scalar_check (number, 0)) + return false; + if (!type_check (number, 0, BT_INTEGER)) + return false; - if (int_or_proc_check (handler, 1) == FAILURE) - return FAILURE; - if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE) - return FAILURE; + if (!int_or_proc_check (handler, 1)) + return false; + if (handler->ts.type == BT_INTEGER && !scalar_check (handler, 1)) + return false; if (status == NULL) - return SUCCESS; + return true; - if (type_check (status, 2, BT_INTEGER) == FAILURE) - return FAILURE; - if (scalar_check (status, 2) == FAILURE) - return FAILURE; + if (!type_check (status, 2, BT_INTEGER)) + return false; + if (!scalar_check (status, 2)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status) { - if (type_check (cmd, 0, BT_CHARACTER) == FAILURE) - return FAILURE; - if (kind_value_check (cmd, 0, gfc_default_character_kind) == FAILURE) - return FAILURE; + if (!type_check (cmd, 0, BT_CHARACTER)) + return false; + if (!kind_value_check (cmd, 0, gfc_default_character_kind)) + return false; - if (scalar_check (status, 1) == FAILURE) - return FAILURE; + if (!scalar_check (status, 1)) + return false; - if (type_check (status, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (status, 1, BT_INTEGER)) + return false; - if (kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE) - return FAILURE; + if (!kind_value_check (status, 1, gfc_default_integer_kind)) + return false; - return SUCCESS; + return true; } /* This is used for the GNU intrinsics AND, OR and XOR. */ -gfc_try +bool gfc_check_and (gfc_expr *i, gfc_expr *j) { if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL) @@ -5608,7 +5607,7 @@ gfc_check_and (gfc_expr *i, gfc_expr *j) gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER " "or LOGICAL", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &i->where); - return FAILURE; + return false; } if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL) @@ -5616,7 +5615,7 @@ gfc_check_and (gfc_expr *i, gfc_expr *j) gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER " "or LOGICAL", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &j->where); - return FAILURE; + return false; } if (i->ts.type != j->ts.type) @@ -5625,20 +5624,20 @@ gfc_check_and (gfc_expr *i, gfc_expr *j) "have the same type", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &j->where); - return FAILURE; + return false; } - if (scalar_check (i, 0) == FAILURE) - return FAILURE; + if (!scalar_check (i, 0)) + return false; - if (scalar_check (j, 1) == FAILURE) - return FAILURE; + if (!scalar_check (j, 1)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_check_storage_size (gfc_expr *a, gfc_expr *kind) { if (a->ts.type == BT_ASSUMED) @@ -5646,7 +5645,7 @@ gfc_check_storage_size (gfc_expr *a, gfc_expr *kind) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &a->where); - return FAILURE; + return false; } if (a->ts.type == BT_PROCEDURE) @@ -5654,25 +5653,25 @@ gfc_check_storage_size (gfc_expr *a, gfc_expr *kind) gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be a " "procedure", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &a->where); - return FAILURE; + return false; } if (kind == NULL) - return SUCCESS; + return true; - if (type_check (kind, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (!type_check (kind, 1, BT_INTEGER)) + return false; - if (scalar_check (kind, 1) == FAILURE) - return FAILURE; + if (!scalar_check (kind, 1)) + return false; if (kind->expr_type != EXPR_CONSTANT) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &kind->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 42c7fa6..f3fe178 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -543,7 +543,7 @@ gfc_intrinsic_hash_value (gfc_typespec *ts) which contains the declared type as '_data' component, plus a pointer component '_vptr' which determines the dynamic type. */ -gfc_try +bool gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, gfc_array_spec **as, bool delayed_vtab) { @@ -560,19 +560,19 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, { gfc_error ("Assumed size polymorphic objects or components, such " "as that at %C, have not yet been implemented"); - return FAILURE; + return false; } if (attr->class_ok) /* Class container has already been built. */ - return SUCCESS; + return true; attr->class_ok = attr->dummy || attr->pointer || attr->allocatable || attr->select_type_temporary || attr->associate_var; if (!attr->class_ok) /* We can not build the class container yet. */ - return SUCCESS; + return true; /* Determine the name of the encapsulating type. */ rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank; @@ -614,13 +614,13 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, if (!ts->u.derived->attr.unlimited_polymorphic) fclass->attr.abstract = ts->u.derived->attr.abstract; fclass->f2k_derived = gfc_get_namespace (NULL, 0); - if (gfc_add_flavor (&fclass->attr, FL_DERIVED, - NULL, &gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_add_flavor (&fclass->attr, FL_DERIVED, NULL, + &gfc_current_locus)) + return false; /* Add component '_data'. */ - if (gfc_add_component (fclass, "_data", &c) == FAILURE) - return FAILURE; + if (!gfc_add_component (fclass, "_data", &c)) + return false; c->ts = *ts; c->ts.type = BT_DERIVED; c->attr.access = ACCESS_PRIVATE; @@ -636,8 +636,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, c->initializer = NULL; /* Add component '_vptr'. */ - if (gfc_add_component (fclass, "_vptr", &c) == FAILURE) - return FAILURE; + if (!gfc_add_component (fclass, "_vptr", &c)) + return false; c->ts.type = BT_DERIVED; if (delayed_vtab || (ts->u.derived->f2k_derived @@ -661,7 +661,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, { gfc_error ("Maximum extension level reached with type '%s' at %L", ts->u.derived->name, &ts->u.derived->declared_at); - return FAILURE; + return false; } fclass->attr.extension = ts->u.derived->attr.extension + 1; @@ -672,7 +672,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, ts->u.derived = fclass; attr->allocatable = attr->pointer = attr->dimension = attr->codimension = 0; (*as) = NULL; - return SUCCESS; + return true; } @@ -692,7 +692,7 @@ add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb) if (c == NULL) { /* Add procedure component. */ - if (gfc_add_component (vtype, name, &c) == FAILURE) + if (!gfc_add_component (vtype, name, &c)) return; if (!c->tb) @@ -1724,7 +1724,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, DO idx = 1, rank strides(idx) = _F._stride (array, dim=idx) sizes(idx) = sizes(i-1) * size(array, dim=idx, kind=index_kind) - if (strides(idx) /= sizes(i-1)) is_contiguous = .false. + if (strides (idx) /= sizes(i-1)) is_contiguous = .false. END DO. */ /* Create loop. */ @@ -1811,7 +1811,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, block->expr2->value.op.op2->ts.kind = gfc_index_integer_kind; block->expr2->ts = idx->ts; - /* if (strides(idx) /= sizes(idx-1)) is_contiguous = .false. */ + /* if (strides (idx) /= sizes(idx-1)) is_contiguous = .false. */ block->next = XCNEW (gfc_code); block = block->next; block->loc = gfc_current_locus; @@ -2202,8 +2202,8 @@ gfc_find_derived_vtab (gfc_symbol *derived) { gfc_get_symbol (name, ns, &vtab); vtab->ts.type = BT_DERIVED; - if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL, - &gfc_current_locus) == FAILURE) + if (!gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL, + &gfc_current_locus)) goto cleanup; vtab->attr.target = 1; vtab->attr.save = SAVE_IMPLICIT; @@ -2219,15 +2219,15 @@ gfc_find_derived_vtab (gfc_symbol *derived) gfc_symbol *parent = NULL, *parent_vtab = NULL; gfc_get_symbol (name, ns, &vtype); - if (gfc_add_flavor (&vtype->attr, FL_DERIVED, - NULL, &gfc_current_locus) == FAILURE) + if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL, + &gfc_current_locus)) goto cleanup; vtype->attr.access = ACCESS_PUBLIC; vtype->attr.vtype = 1; gfc_set_sym_referenced (vtype); /* Add component '_hash'. */ - if (gfc_add_component (vtype, "_hash", &c) == FAILURE) + if (!gfc_add_component (vtype, "_hash", &c)) goto cleanup; c->ts.type = BT_INTEGER; c->ts.kind = 4; @@ -2236,7 +2236,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) NULL, derived->hash_value); /* Add component '_size'. */ - if (gfc_add_component (vtype, "_size", &c) == FAILURE) + if (!gfc_add_component (vtype, "_size", &c)) goto cleanup; c->ts.type = BT_INTEGER; c->ts.kind = 4; @@ -2249,7 +2249,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) NULL, 0); /* Add component _extends. */ - if (gfc_add_component (vtype, "_extends", &c) == FAILURE) + if (!gfc_add_component (vtype, "_extends", &c)) goto cleanup; c->attr.pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -2286,7 +2286,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) } /* Add component _def_init. */ - if (gfc_add_component (vtype, "_def_init", &c) == FAILURE) + if (!gfc_add_component (vtype, "_def_init", &c)) goto cleanup; c->attr.pointer = 1; c->attr.artificial = 1; @@ -2315,7 +2315,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) } /* Add component _copy. */ - if (gfc_add_component (vtype, "_copy", &c) == FAILURE) + if (!gfc_add_component (vtype, "_copy", &c)) goto cleanup; c->attr.proc_pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -2385,7 +2385,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) /* FIXME: Enable ABI-breaking "_final" generation. */ if (0) { - if (gfc_add_component (vtype, "_final", &c) == FAILURE) + if (!gfc_add_component (vtype, "_final", &c)) goto cleanup; c->attr.proc_pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -2528,8 +2528,8 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) { gfc_get_symbol (name, ns, &vtab); vtab->ts.type = BT_DERIVED; - if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL, - &gfc_current_locus) == FAILURE) + if (!gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL, + &gfc_current_locus)) goto cleanup; vtab->attr.target = 1; vtab->attr.save = SAVE_IMPLICIT; @@ -2547,15 +2547,15 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) gfc_namespace *contained; gfc_get_symbol (name, ns, &vtype); - if (gfc_add_flavor (&vtype->attr, FL_DERIVED, - NULL, &gfc_current_locus) == FAILURE) + if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL, + &gfc_current_locus)) goto cleanup; vtype->attr.access = ACCESS_PUBLIC; vtype->attr.vtype = 1; gfc_set_sym_referenced (vtype); /* Add component '_hash'. */ - if (gfc_add_component (vtype, "_hash", &c) == FAILURE) + if (!gfc_add_component (vtype, "_hash", &c)) goto cleanup; c->ts.type = BT_INTEGER; c->ts.kind = 4; @@ -2565,7 +2565,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) NULL, hash); /* Add component '_size'. */ - if (gfc_add_component (vtype, "_size", &c) == FAILURE) + if (!gfc_add_component (vtype, "_size", &c)) goto cleanup; c->ts.type = BT_INTEGER; c->ts.kind = 4; @@ -2578,7 +2578,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) NULL, ts->kind); /* Add component _extends. */ - if (gfc_add_component (vtype, "_extends", &c) == FAILURE) + if (!gfc_add_component (vtype, "_extends", &c)) goto cleanup; c->attr.pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -2586,7 +2586,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) c->initializer = gfc_get_null_expr (NULL); /* Add component _def_init. */ - if (gfc_add_component (vtype, "_def_init", &c) == FAILURE) + if (!gfc_add_component (vtype, "_def_init", &c)) goto cleanup; c->attr.pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -2594,7 +2594,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) c->initializer = gfc_get_null_expr (NULL); /* Add component _copy. */ - if (gfc_add_component (vtype, "_copy", &c) == FAILURE) + if (!gfc_add_component (vtype, "_copy", &c)) goto cleanup; c->attr.proc_pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -2666,7 +2666,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) c->ts.interface = copy; /* Add component _final. */ - if (gfc_add_component (vtype, "_final", &c) == FAILURE) + if (!gfc_add_component (vtype, "_final", &c)) goto cleanup; c->attr.proc_pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -2709,7 +2709,7 @@ cleanup: type-bound user operator. */ static gfc_symtree* -find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t, +find_typebound_proc_uop (gfc_symbol* derived, bool* t, const char* name, bool noaccess, bool uop, locus* where) { @@ -2718,7 +2718,7 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t, /* Set default to failure. */ if (t) - *t = FAILURE; + *t = false; if (derived->f2k_derived) /* Set correct symbol-root. */ @@ -2733,7 +2733,7 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t, { /* We found one. */ if (t) - *t = SUCCESS; + *t = true; if (!noaccess && derived->attr.use_assoc && res->n.tb->access == ACCESS_PRIVATE) @@ -2742,7 +2742,7 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t, gfc_error ("'%s' of '%s' is PRIVATE at %L", name, derived->name, where); if (t) - *t = FAILURE; + *t = false; } return res; @@ -2768,14 +2768,14 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t, (looking recursively through the super-types). */ gfc_symtree* -gfc_find_typebound_proc (gfc_symbol* derived, gfc_try* t, +gfc_find_typebound_proc (gfc_symbol* derived, bool* t, const char* name, bool noaccess, locus* where) { return find_typebound_proc_uop (derived, t, name, noaccess, false, where); } gfc_symtree* -gfc_find_typebound_user_op (gfc_symbol* derived, gfc_try* t, +gfc_find_typebound_user_op (gfc_symbol* derived, bool* t, const char* name, bool noaccess, locus* where) { return find_typebound_proc_uop (derived, t, name, noaccess, true, where); @@ -2786,7 +2786,7 @@ gfc_find_typebound_user_op (gfc_symbol* derived, gfc_try* t, super-type hierarchy. */ gfc_typebound_proc* -gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t, +gfc_find_typebound_intrinsic_op (gfc_symbol* derived, bool* t, gfc_intrinsic_op op, bool noaccess, locus* where) { @@ -2794,7 +2794,7 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t, /* Set default to failure. */ if (t) - *t = FAILURE; + *t = false; /* Try to find it in the current type's namespace. */ if (derived->f2k_derived) @@ -2807,7 +2807,7 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t, { /* We found one. */ if (t) - *t = SUCCESS; + *t = true; if (!noaccess && derived->attr.use_assoc && res->access == ACCESS_PRIVATE) @@ -2816,7 +2816,7 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t, gfc_error ("'%s' of '%s' is PRIVATE at %L", gfc_op2string (op), derived->name, where); if (t) - *t = FAILURE; + *t = false; } return res; diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index 0a176b2..ea53681 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.c @@ -609,11 +609,11 @@ gfc_cpp_init (void) pp_dir_change (cpp_in, get_src_pwd ()); } -gfc_try +bool gfc_cpp_preprocess (const char *source_file) { if (!gfc_cpp_enabled ()) - return FAILURE; + return false; cpp_change_file (cpp_in, LC_RENAME, source_file); @@ -636,7 +636,7 @@ gfc_cpp_preprocess (const char *source_file) || (gfc_cpp_preprocess_only () && gfc_cpp_option.output_filename)) fclose (print.outf); - return SUCCESS; + return true; } void diff --git a/gcc/fortran/cpp.h b/gcc/fortran/cpp.h index fc5c282..04e13be 100644 --- a/gcc/fortran/cpp.h +++ b/gcc/fortran/cpp.h @@ -43,7 +43,7 @@ int gfc_cpp_handle_option(size_t scode, const char *arg, int value); void gfc_cpp_post_options (void); -gfc_try gfc_cpp_preprocess (const char *source_file); +bool gfc_cpp_preprocess (const char *source_file); void gfc_cpp_done (void); diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 6aaa315..f297ef5 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -129,8 +129,8 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts, start_expr = gfc_copy_expr (ref->u.ss.start); end_expr = gfc_copy_expr (ref->u.ss.end); - if ((gfc_simplify_expr (start_expr, 1) == FAILURE) - || (gfc_simplify_expr (end_expr, 1)) == FAILURE) + if ((!gfc_simplify_expr(start_expr, 1)) + || !(gfc_simplify_expr(end_expr, 1))) { gfc_error ("failure to simplify substring reference in DATA " "statement at %L", &ref->u.ss.start->where); @@ -196,7 +196,7 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts, consecutive values in LVALUE the same value in RVALUE. In that case, LVALUE must refer to a full array, not an array section. */ -gfc_try +bool gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, mpz_t *repeat) { @@ -283,7 +283,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, && ref->next == NULL); mpz_init_set (end, offset); mpz_add (end, end, *repeat); - if (spec_size (ref->u.ar.as, &size) == SUCCESS) + if (spec_size (ref->u.ar.as, &size)) { if (mpz_cmp (end, size) > 0) { @@ -319,8 +319,8 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, ? con->expr : rvalue; if (gfc_notify_std (GFC_STD_GNU, "re-initialization of '%s' at %L", - symbol->name, &exprd->where) == FAILURE) - return FAILURE; + symbol->name, &exprd->where) == false) + return false; } while (con != NULL) @@ -372,7 +372,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, else { mpz_t size; - if (spec_size (ref->u.ar.as, &size) == SUCCESS) + if (spec_size (ref->u.ar.as, &size)) { if (mpz_cmp (offset, size) >= 0) { @@ -468,7 +468,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, if (ref || last_ts->type == BT_CHARACTER) { if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL)) - return FAILURE; + return false; expr = create_character_initializer (init, last_ts, ref, rvalue); } else @@ -485,8 +485,8 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, ? init : rvalue; if (gfc_notify_std (GFC_STD_GNU, "re-initialization of '%s' at %L", - symbol->name, &expr->where) == FAILURE) - return FAILURE; + symbol->name, &expr->where) == false) + return false; } expr = gfc_copy_expr (rvalue); @@ -499,13 +499,13 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, else last_con->expr = expr; - return SUCCESS; + return true; abort: if (!init) gfc_free_expr (expr); mpz_clear (offset); - return FAILURE; + return false; } diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h index 8332a3b..04114dc 100644 --- a/gcc/fortran/data.h +++ b/gcc/fortran/data.h @@ -19,5 +19,5 @@ along with GCC; see the file COPYING3. If not see void gfc_formalize_init_value (gfc_symbol *); void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *); -gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *); +bool gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *); void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *); diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 3188eae..ffaa65d 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 (); diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index 062b1c5..6f8e6df 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -756,7 +756,7 @@ gfc_dep_difference (gfc_expr *e1, gfc_expr *e2, mpz_t *result) } } - if (gfc_dep_compare_expr(e1, e2) == 0) + if (gfc_dep_compare_expr (e1, e2) == 0) { /* Case 18: X - X = 0. */ mpz_set_si (*result, 0); @@ -1548,7 +1548,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n) #define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \ && (a)->ts.type == BT_INTEGER) - if (IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride) + if (IS_CONSTANT_INTEGER (l_stride) && IS_CONSTANT_INTEGER (r_stride) && gfc_dep_difference (l_start, r_start, &tmp)) { mpz_t gcd; diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index c47e655e..60b2093 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -806,10 +806,10 @@ gfc_notification_std (int std) /* Possibly issue a warning/error about use of a nonstandard (or deleted) feature. An error/warning will be issued if the currently selected - standard does not contain the requested bits. Return FAILURE if + standard does not contain the requested bits. Return false if an error is generated. */ -gfc_try +bool gfc_notify_std (int std, const char *gmsgid, ...) { va_list argp; @@ -819,10 +819,10 @@ gfc_notify_std (int std, const char *gmsgid, ...) warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings; if ((gfc_option.allow_std & std) != 0 && !warning) - return SUCCESS; + return true; if (suppress_errors) - return warning ? SUCCESS : FAILURE; + return warning ? true : false; cur_error_buffer = warning ? &warning_buffer : &error_buffer; cur_error_buffer->flag = 1; @@ -883,7 +883,7 @@ gfc_notify_std (int std, const char *gmsgid, ...) cur_error_buffer->flag = 0; } - return (warning && !warnings_are_errors) ? SUCCESS : FAILURE; + return (warning && !warnings_are_errors) ? true : false; } diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 8deb4eb..1a531d9 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -610,7 +610,7 @@ gfc_replace_expr (gfc_expr *dest, gfc_expr *src) /* Try to extract an integer constant from the passed expression node. Returns an error message or NULL if the result is set. It is - tempting to generate an error and return SUCCESS or FAILURE, but + tempting to generate an error and return true or false, but failure is OK for some callers. */ const char * @@ -1005,27 +1005,27 @@ is_subref_array (gfc_expr * e) /* Try to collapse intrinsic expressions. */ -static gfc_try +static bool simplify_intrinsic_op (gfc_expr *p, int type) { gfc_intrinsic_op op; gfc_expr *op1, *op2, *result; if (p->value.op.op == INTRINSIC_USER) - return SUCCESS; + return true; op1 = p->value.op.op1; op2 = p->value.op.op2; op = p->value.op.op; - if (gfc_simplify_expr (op1, type) == FAILURE) - return FAILURE; - if (gfc_simplify_expr (op2, type) == FAILURE) - return FAILURE; + if (!gfc_simplify_expr (op1, type)) + return false; + if (!gfc_simplify_expr (op2, type)) + return false; if (!gfc_is_constant_expr (op1) || (op2 != NULL && !gfc_is_constant_expr (op2))) - return SUCCESS; + return true; /* Rip p apart. */ p->value.op.op1 = NULL; @@ -1127,21 +1127,21 @@ simplify_intrinsic_op (gfc_expr *p, int type) { gfc_free_expr (op1); gfc_free_expr (op2); - return FAILURE; + return false; } result->rank = p->rank; result->where = p->where; gfc_replace_expr (p, result); - return SUCCESS; + return true; } /* Subroutine to simplify constructor expressions. Mutually recursive with gfc_simplify_expr(). */ -static gfc_try +static bool simplify_constructor (gfc_constructor_base base, int type) { gfc_constructor *c; @@ -1150,10 +1150,10 @@ simplify_constructor (gfc_constructor_base base, int type) for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c)) { if (c->iterator - && (gfc_simplify_expr (c->iterator->start, type) == FAILURE - || gfc_simplify_expr (c->iterator->end, type) == FAILURE - || gfc_simplify_expr (c->iterator->step, type) == FAILURE)) - return FAILURE; + && (!gfc_simplify_expr(c->iterator->start, type) + || !gfc_simplify_expr (c->iterator->end, type) + || !gfc_simplify_expr (c->iterator->step, type))) + return false; if (c->expr) { @@ -1162,7 +1162,7 @@ simplify_constructor (gfc_constructor_base base, int type) doing so can make a dog's dinner of complicated things. */ p = gfc_copy_expr (c->expr); - if (gfc_simplify_expr (p, type) == FAILURE) + if (!gfc_simplify_expr (p, type)) { gfc_free_expr (p); continue; @@ -1172,13 +1172,13 @@ simplify_constructor (gfc_constructor_base base, int type) } } - return SUCCESS; + return true; } /* Pull a single array element out of an array constructor. */ -static gfc_try +static bool find_array_element (gfc_constructor_base base, gfc_array_ref *ar, gfc_constructor **rval) { @@ -1190,9 +1190,9 @@ find_array_element (gfc_constructor_base base, gfc_array_ref *ar, mpz_t tmp; gfc_constructor *cons; gfc_expr *e; - gfc_try t; + bool t; - t = SUCCESS; + t = true; e = NULL; mpz_init_set_ui (offset, 0); @@ -1201,10 +1201,10 @@ find_array_element (gfc_constructor_base base, gfc_array_ref *ar, mpz_init_set_ui (span, 1); for (i = 0; i < ar->dimen; i++) { - if (gfc_reduce_init_expr (ar->as->lower[i]) == FAILURE - || gfc_reduce_init_expr (ar->as->upper[i]) == FAILURE) + if (!gfc_reduce_init_expr (ar->as->lower[i]) + || !gfc_reduce_init_expr (ar->as->upper[i])) { - t = FAILURE; + t = false; cons = NULL; goto depart; } @@ -1229,7 +1229,7 @@ find_array_element (gfc_constructor_base base, gfc_array_ref *ar, gfc_error ("Index in dimension %d is out of bounds " "at %L", i + 1, &ar->c_where[i]); cons = NULL; - t = FAILURE; + t = false; goto depart; } @@ -1309,7 +1309,7 @@ remove_subobject_ref (gfc_expr *p, gfc_constructor *cons) /* Pull an array section out of an array constructor. */ -static gfc_try +static bool find_array_section (gfc_expr *expr, gfc_ref *ref) { int idx; @@ -1335,9 +1335,9 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) gfc_expr *step; gfc_expr *upper; gfc_expr *lower; - gfc_try t; + bool t; - t = SUCCESS; + t = true; base = expr->value.constructor; expr->value.constructor = NULL; @@ -1381,7 +1381,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) if (begin->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (begin)) { - t = FAILURE; + t = false; goto cleanup; } @@ -1407,7 +1407,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) { gfc_error ("index in dimension %d is out of bounds " "at %L", d + 1, &ref->u.ar.c_where[d]); - t = FAILURE; + t = false; goto cleanup; } } @@ -1418,7 +1418,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) || (finish && finish->expr_type != EXPR_CONSTANT) || (step && step->expr_type != EXPR_CONSTANT)) { - t = FAILURE; + t = false; goto cleanup; } @@ -1458,7 +1458,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) { gfc_error ("index in dimension %d is out of bounds " "at %L", d + 1, &ref->u.ar.c_where[d]); - t = FAILURE; + t = false; goto cleanup; } @@ -1537,7 +1537,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) "upper limit. See -fmax-array-constructor " "option", &expr->where, gfc_option.flag_max_array_constructor); - return FAILURE; + return false; } cons = gfc_constructor_lookup (base, limit); @@ -1567,7 +1567,7 @@ cleanup: /* Pull a substring out of an expression. */ -static gfc_try +static bool find_substring_ref (gfc_expr *p, gfc_expr **newp) { int end; @@ -1577,7 +1577,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT || p->ref->u.ss.end->expr_type != EXPR_CONSTANT) - return FAILURE; + return false; *newp = gfc_copy_expr (p); free ((*newp)->value.character.string); @@ -1591,7 +1591,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) memcpy (chr, &p->value.character.string[start - 1], length * sizeof (gfc_char_t)); chr[length] = '\0'; - return SUCCESS; + return true; } @@ -1599,7 +1599,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) /* Simplify a subobject reference of a constructor. This occurs when parameter variable values are substituted. */ -static gfc_try +static bool simplify_const_ref (gfc_expr *p) { gfc_constructor *cons, *c; @@ -1621,19 +1621,18 @@ simplify_const_ref (gfc_expr *p) remove_subobject_ref (p, NULL); break; } - if (find_array_element (p->value.constructor, &p->ref->u.ar, - &cons) == FAILURE) - return FAILURE; + if (!find_array_element (p->value.constructor, &p->ref->u.ar, &cons)) + return false; if (!cons) - return SUCCESS; + return true; remove_subobject_ref (p, cons); break; case AR_SECTION: - if (find_array_section (p, p->ref) == FAILURE) - return FAILURE; + if (!find_array_section (p, p->ref)) + return false; p->ref->u.ar.type = AR_FULL; /* Fall through. */ @@ -1646,8 +1645,8 @@ simplify_const_ref (gfc_expr *p) c; c = gfc_constructor_next (c)) { c->expr->ref = gfc_copy_ref (p->ref->next); - if (simplify_const_ref (c->expr) == FAILURE) - return FAILURE; + if (!simplify_const_ref (c->expr)) + return false; } if (p->ts.type == BT_DERIVED @@ -1695,7 +1694,7 @@ simplify_const_ref (gfc_expr *p) break; default: - return SUCCESS; + return true; } break; @@ -1706,8 +1705,8 @@ simplify_const_ref (gfc_expr *p) break; case REF_SUBSTRING: - if (find_substring_ref (p, &newp) == FAILURE) - return FAILURE; + if (!find_substring_ref (p, &newp)) + return false; gfc_replace_expr (p, newp); gfc_free_ref_list (p->ref); @@ -1716,13 +1715,13 @@ simplify_const_ref (gfc_expr *p) } } - return SUCCESS; + return true; } /* Simplify a chain of references. */ -static gfc_try +static bool simplify_ref_chain (gfc_ref *ref, int type) { int n; @@ -1734,41 +1733,41 @@ simplify_ref_chain (gfc_ref *ref, int type) case REF_ARRAY: for (n = 0; n < ref->u.ar.dimen; n++) { - if (gfc_simplify_expr (ref->u.ar.start[n], type) == FAILURE) - return FAILURE; - if (gfc_simplify_expr (ref->u.ar.end[n], type) == FAILURE) - return FAILURE; - if (gfc_simplify_expr (ref->u.ar.stride[n], type) == FAILURE) - return FAILURE; + if (!gfc_simplify_expr (ref->u.ar.start[n], type)) + return false; + if (!gfc_simplify_expr (ref->u.ar.end[n], type)) + return false; + if (!gfc_simplify_expr (ref->u.ar.stride[n], type)) + return false; } break; case REF_SUBSTRING: - if (gfc_simplify_expr (ref->u.ss.start, type) == FAILURE) - return FAILURE; - if (gfc_simplify_expr (ref->u.ss.end, type) == FAILURE) - return FAILURE; + if (!gfc_simplify_expr (ref->u.ss.start, type)) + return false; + if (!gfc_simplify_expr (ref->u.ss.end, type)) + return false; break; default: break; } } - return SUCCESS; + return true; } /* Try to substitute the value of a parameter variable. */ -static gfc_try +static bool simplify_parameter_variable (gfc_expr *p, int type) { gfc_expr *e; - gfc_try t; + bool t; e = gfc_copy_expr (p->symtree->n.sym->value); if (e == NULL) - return FAILURE; + return false; e->rank = p->rank; @@ -1778,7 +1777,7 @@ simplify_parameter_variable (gfc_expr *p, int type) t = gfc_simplify_expr (e, type); /* Only use the simplification if it eliminated all subobject references. */ - if (t == SUCCESS && !e->ref) + if (t && !e->ref) gfc_replace_expr (p, e); else gfc_free_expr (e); @@ -1802,16 +1801,16 @@ simplify_parameter_variable (gfc_expr *p, int type) 0 Basic expression parsing 1 Simplifying array constructors -- will substitute iterator values. - Returns FAILURE on error, SUCCESS otherwise. - NOTE: Will return SUCCESS even if the expression can not be simplified. */ + Returns false on error, true otherwise. + NOTE: Will return true even if the expression can not be simplified. */ -gfc_try +bool gfc_simplify_expr (gfc_expr *p, int type) { gfc_actual_arglist *ap; if (p == NULL) - return SUCCESS; + return true; switch (p->expr_type) { @@ -1821,18 +1820,18 @@ gfc_simplify_expr (gfc_expr *p, int type) case EXPR_FUNCTION: for (ap = p->value.function.actual; ap; ap = ap->next) - if (gfc_simplify_expr (ap->expr, type) == FAILURE) - return FAILURE; + if (!gfc_simplify_expr (ap->expr, type)) + return false; if (p->value.function.isym != NULL && gfc_intrinsic_func_interface (p, 1) == MATCH_ERROR) - return FAILURE; + return false; break; case EXPR_SUBSTRING: - if (simplify_ref_chain (p->ref, type) == FAILURE) - return FAILURE; + if (!simplify_ref_chain (p->ref, type)) + return false; if (gfc_is_constant_expr (p)) { @@ -1871,8 +1870,8 @@ gfc_simplify_expr (gfc_expr *p, int type) break; case EXPR_OP: - if (simplify_intrinsic_op (p, type) == FAILURE) - return FAILURE; + if (!simplify_intrinsic_op (p, type)) + return false; break; case EXPR_VARIABLE: @@ -1882,8 +1881,8 @@ gfc_simplify_expr (gfc_expr *p, int type) && (gfc_init_expr_flag || p->ref || p->symtree->n.sym->value->expr_type != EXPR_ARRAY)) { - if (simplify_parameter_variable (p, type) == FAILURE) - return FAILURE; + if (!simplify_parameter_variable (p, type)) + return false; break; } @@ -1893,25 +1892,25 @@ gfc_simplify_expr (gfc_expr *p, int type) } /* Simplify subcomponent references. */ - if (simplify_ref_chain (p->ref, type) == FAILURE) - return FAILURE; + if (!simplify_ref_chain (p->ref, type)) + return false; break; case EXPR_STRUCTURE: case EXPR_ARRAY: - if (simplify_ref_chain (p->ref, type) == FAILURE) - return FAILURE; + if (!simplify_ref_chain (p->ref, type)) + return false; - if (simplify_constructor (p->value.constructor, type) == FAILURE) - return FAILURE; + if (!simplify_constructor (p->value.constructor, type)) + return false; if (p->expr_type == EXPR_ARRAY && p->ref && p->ref->type == REF_ARRAY && p->ref->u.ar.type == AR_FULL) gfc_expand_constructor (p, false); - if (simplify_const_ref (p) == FAILURE) - return FAILURE; + if (!simplify_const_ref (p)) + return false; break; @@ -1921,7 +1920,7 @@ gfc_simplify_expr (gfc_expr *p, int type) break; } - return SUCCESS; + return true; } @@ -1932,7 +1931,7 @@ gfc_simplify_expr (gfc_expr *p, int type) static bt et0 (gfc_expr *e) { - if (e->expr_type == EXPR_VARIABLE && gfc_check_iter_variable (e) == SUCCESS) + if (e->expr_type == EXPR_VARIABLE && gfc_check_iter_variable (e)) return BT_INTEGER; return e->ts.type; @@ -1941,7 +1940,7 @@ et0 (gfc_expr *e) /* Scalarize an expression for an elemental intrinsic call. */ -static gfc_try +static bool scalarize_intrinsic_call (gfc_expr *e) { gfc_actual_arglist *a, *b; @@ -1967,7 +1966,7 @@ scalarize_intrinsic_call (gfc_expr *e) } if (!array_arg) - return FAILURE; + return false; old = gfc_copy_expr (e); @@ -1984,7 +1983,7 @@ scalarize_intrinsic_call (gfc_expr *e) for (; a; a = a->next) { /* Check that this is OK for an initialization expression. */ - if (a->expr && gfc_check_init_expr (a->expr) == FAILURE) + if (a->expr && !gfc_check_init_expr (a->expr)) goto cleanup; rank[n] = 0; @@ -2060,7 +2059,7 @@ scalarize_intrinsic_call (gfc_expr *e) /* Free "expr" but not the pointers it contains. */ free (expr); gfc_free_expr (old); - return SUCCESS; + return true; compliance: gfc_error_now ("elemental function arguments at %C are not compliant"); @@ -2068,18 +2067,18 @@ compliance: cleanup: gfc_free_expr (expr); gfc_free_expr (old); - return FAILURE; + return false; } -static gfc_try -check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *)) +static bool +check_intrinsic_op (gfc_expr *e, bool (*check_function) (gfc_expr *)) { gfc_expr *op1 = e->value.op.op1; gfc_expr *op2 = e->value.op.op2; - if ((*check_function) (op1) == FAILURE) - return FAILURE; + if (!(*check_function)(op1)) + return false; switch (e->value.op.op) { @@ -2101,15 +2100,15 @@ check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *)) case INTRINSIC_LT_OS: case INTRINSIC_LE: case INTRINSIC_LE_OS: - if ((*check_function) (op2) == FAILURE) - return FAILURE; + if (!(*check_function)(op2)) + return false; if (!(et0 (op1) == BT_CHARACTER && et0 (op2) == BT_CHARACTER) && !(numeric_type (et0 (op1)) && numeric_type (et0 (op2)))) { gfc_error ("Numeric or CHARACTER operands are required in " "expression at %L", &e->where); - return FAILURE; + return false; } break; @@ -2118,8 +2117,8 @@ check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *)) case INTRINSIC_TIMES: case INTRINSIC_DIVIDE: case INTRINSIC_POWER: - if ((*check_function) (op2) == FAILURE) - return FAILURE; + if (!(*check_function)(op2)) + return false; if (!numeric_type (et0 (op1)) || !numeric_type (et0 (op2))) goto not_numeric; @@ -2127,21 +2126,21 @@ check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *)) break; case INTRINSIC_CONCAT: - if ((*check_function) (op2) == FAILURE) - return FAILURE; + if (!(*check_function)(op2)) + return false; if (et0 (op1) != BT_CHARACTER || et0 (op2) != BT_CHARACTER) { gfc_error ("Concatenation operator in expression at %L " "must have two CHARACTER operands", &op1->where); - return FAILURE; + return false; } if (op1->ts.kind != op2->ts.kind) { gfc_error ("Concat operator at %L must concatenate strings of the " "same kind", &e->where); - return FAILURE; + return false; } break; @@ -2151,7 +2150,7 @@ check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *)) { gfc_error (".NOT. operator in expression at %L must have a LOGICAL " "operand", &op1->where); - return FAILURE; + return false; } break; @@ -2160,14 +2159,14 @@ check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *)) case INTRINSIC_OR: case INTRINSIC_EQV: case INTRINSIC_NEQV: - if ((*check_function) (op2) == FAILURE) - return FAILURE; + if (!(*check_function)(op2)) + return false; if (et0 (op1) != BT_LOGICAL || et0 (op2) != BT_LOGICAL) { gfc_error ("LOGICAL operands are required in expression at %L", &e->where); - return FAILURE; + return false; } break; @@ -2178,20 +2177,20 @@ check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *)) default: gfc_error ("Only intrinsic operators can be used in expression at %L", &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; not_numeric: gfc_error ("Numeric operands are required in expression at %L", &e->where); - return FAILURE; + return false; } /* F2003, 7.1.7 (3): In init expression, allocatable components must not be data-initialized. */ -static gfc_try +static bool check_alloc_comp_init (gfc_expr *e) { gfc_component *comp; @@ -2210,11 +2209,11 @@ check_alloc_comp_init (gfc_expr *e) gfc_error("Invalid initialization expression for ALLOCATABLE " "component '%s' in structure constructor at %L", comp->name, &ctor->expr->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } static match @@ -2223,13 +2222,13 @@ check_init_expr_arguments (gfc_expr *e) gfc_actual_arglist *ap; for (ap = e->value.function.actual; ap; ap = ap->next) - if (gfc_check_init_expr (ap->expr) == FAILURE) + if (!gfc_check_init_expr (ap->expr)) return MATCH_ERROR; return MATCH_YES; } -static gfc_try check_restricted (gfc_expr *); +static bool check_restricted (gfc_expr *); /* F95, 7.1.6.1, Initialization expressions, (7) F2003, 7.1.7 Initialization expression, (8) */ @@ -2305,8 +2304,7 @@ check_inquiry (gfc_expr *e, int not_restricted) if (ap->expr->ts.type == BT_UNKNOWN) { if (ap->expr->symtree->n.sym->ts.type == BT_UNKNOWN - && gfc_set_default_type (ap->expr->symtree->n.sym, 0, gfc_current_ns) - == FAILURE) + && !gfc_set_default_type (ap->expr->symtree->n.sym, 0, gfc_current_ns)) return MATCH_NO; ap->expr->ts = ap->expr->symtree->n.sym->ts; @@ -2325,12 +2323,12 @@ check_inquiry (gfc_expr *e, int not_restricted) &ap->expr->where); return MATCH_ERROR; } - else if (not_restricted && gfc_check_init_expr (ap->expr) == FAILURE) + else if (not_restricted && !gfc_check_init_expr (ap->expr)) return MATCH_ERROR; if (not_restricted == 0 && ap->expr->expr_type != EXPR_VARIABLE - && check_restricted (ap->expr) == FAILURE) + && !check_restricted (ap->expr)) return MATCH_ERROR; if (not_restricted == 0 @@ -2416,9 +2414,8 @@ check_elemental (gfc_expr *e) if (e->ts.type != BT_INTEGER && e->ts.type != BT_CHARACTER - && gfc_notify_std (GFC_STD_F2003, "Evaluation of " - "nonstandard initialization expression at %L", - &e->where) == FAILURE) + && !gfc_notify_std (GFC_STD_F2003, "Evaluation of nonstandard " + "initialization expression at %L", &e->where)) return MATCH_ERROR; return check_init_expr_arguments (e); @@ -2441,28 +2438,28 @@ check_conversion (gfc_expr *e) node if all goes well. This would normally happen when the expression is constructed but function references are assumed to be intrinsics in the context of initialization expressions. If - FAILURE is returned an error message has been generated. */ + false is returned an error message has been generated. */ -gfc_try +bool gfc_check_init_expr (gfc_expr *e) { match m; - gfc_try t; + bool t; if (e == NULL) - return SUCCESS; + return true; switch (e->expr_type) { case EXPR_OP: t = check_intrinsic_op (e, gfc_check_init_expr); - if (t == SUCCESS) + if (t) t = gfc_simplify_expr (e, 0); break; case EXPR_FUNCTION: - t = FAILURE; + t = false; { gfc_intrinsic_sym* isym; @@ -2491,13 +2488,13 @@ gfc_check_init_expr (gfc_expr *e) } if (m == MATCH_ERROR) - return FAILURE; + return false; /* Try to scalarize an elemental intrinsic function that has an array argument. */ isym = gfc_find_function (e->symtree->n.sym->name); if (isym && isym->elemental - && (t = scalarize_intrinsic_call (e)) == SUCCESS) + && (t = scalarize_intrinsic_call(e))) break; } @@ -2507,9 +2504,9 @@ gfc_check_init_expr (gfc_expr *e) break; case EXPR_VARIABLE: - t = SUCCESS; + t = true; - if (gfc_check_iter_variable (e) == SUCCESS) + if (gfc_check_iter_variable (e)) break; if (e->symtree->n.sym->attr.flavor == FL_PARAMETER) @@ -2521,7 +2518,7 @@ gfc_check_init_expr (gfc_expr *e) { gfc_error("PARAMETER '%s' is used at %L before its definition " "is complete", e->symtree->n.sym->name, &e->where); - t = FAILURE; + t = false; } else t = simplify_parameter_variable (e, 0); @@ -2532,7 +2529,7 @@ gfc_check_init_expr (gfc_expr *e) if (gfc_in_match_data ()) break; - t = FAILURE; + t = false; if (e->symtree->n.sym->as) { @@ -2575,42 +2572,42 @@ gfc_check_init_expr (gfc_expr *e) case EXPR_CONSTANT: case EXPR_NULL: - t = SUCCESS; + t = true; break; case EXPR_SUBSTRING: t = gfc_check_init_expr (e->ref->u.ss.start); - if (t == FAILURE) + if (!t) break; t = gfc_check_init_expr (e->ref->u.ss.end); - if (t == SUCCESS) + if (t) t = gfc_simplify_expr (e, 0); break; case EXPR_STRUCTURE: - t = e->ts.is_iso_c ? SUCCESS : FAILURE; - if (t == SUCCESS) + t = e->ts.is_iso_c ? true : false; + if (t) break; t = check_alloc_comp_init (e); - if (t == FAILURE) + if (!t) break; t = gfc_check_constructor (e, gfc_check_init_expr); - if (t == FAILURE) + if (!t) break; break; case EXPR_ARRAY: t = gfc_check_constructor (e, gfc_check_init_expr); - if (t == FAILURE) + if (!t) break; t = gfc_expand_constructor (e, true); - if (t == FAILURE) + if (!t) break; t = gfc_check_constructor_type (e); @@ -2625,31 +2622,31 @@ gfc_check_init_expr (gfc_expr *e) /* Reduces a general expression to an initialization expression (a constant). This used to be part of gfc_match_init_expr. - Note that this function doesn't free the given expression on FAILURE. */ + Note that this function doesn't free the given expression on false. */ -gfc_try +bool gfc_reduce_init_expr (gfc_expr *expr) { - gfc_try t; + bool t; gfc_init_expr_flag = true; t = gfc_resolve_expr (expr); - if (t == SUCCESS) + if (t) t = gfc_check_init_expr (expr); gfc_init_expr_flag = false; - if (t == FAILURE) - return FAILURE; + if (!t) + return false; if (expr->expr_type == EXPR_ARRAY) { - if (gfc_check_constructor_type (expr) == FAILURE) - return FAILURE; - if (gfc_expand_constructor (expr, true) == FAILURE) - return FAILURE; + if (!gfc_check_constructor_type (expr)) + return false; + if (!gfc_expand_constructor (expr, true)) + return false; } - return SUCCESS; + return true; } @@ -2661,7 +2658,7 @@ gfc_match_init_expr (gfc_expr **result) { gfc_expr *expr; match m; - gfc_try t; + bool t; expr = NULL; @@ -2675,7 +2672,7 @@ gfc_match_init_expr (gfc_expr **result) } t = gfc_reduce_init_expr (expr); - if (t != SUCCESS) + if (!t) { gfc_free_expr (expr); gfc_init_expr_flag = false; @@ -2693,16 +2690,16 @@ gfc_match_init_expr (gfc_expr **result) restricted expression and optionally if the expression type is integer or character. */ -static gfc_try +static bool restricted_args (gfc_actual_arglist *a) { for (; a; a = a->next) { - if (check_restricted (a->expr) == FAILURE) - return FAILURE; + if (!check_restricted (a->expr)) + return false; } - return SUCCESS; + return true; } @@ -2711,7 +2708,7 @@ restricted_args (gfc_actual_arglist *a) /* Make sure a non-intrinsic function is a specification function. */ -static gfc_try +static bool external_spec_function (gfc_expr *e) { gfc_symbol *f; @@ -2722,28 +2719,28 @@ external_spec_function (gfc_expr *e) { gfc_error ("Specification function '%s' at %L cannot be a statement " "function", f->name, &e->where); - return FAILURE; + return false; } if (f->attr.proc == PROC_INTERNAL) { gfc_error ("Specification function '%s' at %L cannot be an internal " "function", f->name, &e->where); - return FAILURE; + return false; } if (!f->attr.pure && !f->attr.elemental) { gfc_error ("Specification function '%s' at %L must be PURE", f->name, &e->where); - return FAILURE; + return false; } if (f->attr.recursive) { gfc_error ("Specification function '%s' at %L cannot be RECURSIVE", f->name, &e->where); - return FAILURE; + return false; } return restricted_args (e->value.function.actual); @@ -2753,12 +2750,12 @@ external_spec_function (gfc_expr *e) /* Check to see that a function reference to an intrinsic is a restricted expression. */ -static gfc_try +static bool restricted_intrinsic (gfc_expr *e) { /* TODO: Check constraints on inquiry functions. 7.1.6.2 (7). */ if (check_inquiry (e, 0) == MATCH_YES) - return SUCCESS; + return true; return restricted_args (e->value.function.actual); } @@ -2766,39 +2763,39 @@ restricted_intrinsic (gfc_expr *e) /* Check the expressions of an actual arglist. Used by check_restricted. */ -static gfc_try -check_arglist (gfc_actual_arglist* arg, gfc_try (*checker) (gfc_expr*)) +static bool +check_arglist (gfc_actual_arglist* arg, bool (*checker) (gfc_expr*)) { for (; arg; arg = arg->next) - if (checker (arg->expr) == FAILURE) - return FAILURE; + if (!checker (arg->expr)) + return false; - return SUCCESS; + return true; } /* Check the subscription expressions of a reference chain with a checking function; used by check_restricted. */ -static gfc_try -check_references (gfc_ref* ref, gfc_try (*checker) (gfc_expr*)) +static bool +check_references (gfc_ref* ref, bool (*checker) (gfc_expr*)) { int dim; if (!ref) - return SUCCESS; + return true; switch (ref->type) { case REF_ARRAY: for (dim = 0; dim != ref->u.ar.dimen; ++dim) { - if (checker (ref->u.ar.start[dim]) == FAILURE) - return FAILURE; - if (checker (ref->u.ar.end[dim]) == FAILURE) - return FAILURE; - if (checker (ref->u.ar.stride[dim]) == FAILURE) - return FAILURE; + if (!checker (ref->u.ar.start[dim])) + return false; + if (!checker (ref->u.ar.end[dim])) + return false; + if (!checker (ref->u.ar.stride[dim])) + return false; } break; @@ -2807,10 +2804,10 @@ check_references (gfc_ref* ref, gfc_try (*checker) (gfc_expr*)) break; case REF_SUBSTRING: - if (checker (ref->u.ss.start) == FAILURE) - return FAILURE; - if (checker (ref->u.ss.end) == FAILURE) - return FAILURE; + if (!checker (ref->u.ss.start)) + return false; + if (!checker (ref->u.ss.end)) + return false; break; default: @@ -2824,22 +2821,22 @@ check_references (gfc_ref* ref, gfc_try (*checker) (gfc_expr*)) /* Verify that an expression is a restricted expression. Like its cousin check_init_expr(), an error message is generated if we - return FAILURE. */ + return false. */ -static gfc_try +static bool check_restricted (gfc_expr *e) { gfc_symbol* sym; - gfc_try t; + bool t; if (e == NULL) - return SUCCESS; + return true; switch (e->expr_type) { case EXPR_OP: t = check_intrinsic_op (e, check_restricted); - if (t == SUCCESS) + if (t) t = gfc_simplify_expr (e, 0); break; @@ -2848,24 +2845,24 @@ check_restricted (gfc_expr *e) if (e->value.function.esym) { t = check_arglist (e->value.function.actual, &check_restricted); - if (t == SUCCESS) + if (t) t = external_spec_function (e); } else { if (e->value.function.isym && e->value.function.isym->inquiry) - t = SUCCESS; + t = true; else t = check_arglist (e->value.function.actual, &check_restricted); - if (t == SUCCESS) + if (t) t = restricted_intrinsic (e); } break; case EXPR_VARIABLE: sym = e->symtree->n.sym; - t = FAILURE; + t = false; /* If a dummy argument appears in a context that is valid for a restricted expression in an elemental procedure, it will have @@ -2895,7 +2892,7 @@ check_restricted (gfc_expr *e) } /* Check reference chain if any. */ - if (check_references (e->ref, &check_restricted) == FAILURE) + if (!check_references (e->ref, &check_restricted)) break; /* gfc_is_formal_arg broadcasts that a formal argument list is being @@ -2916,7 +2913,7 @@ check_restricted (gfc_expr *e) && sym->ns->proc_name->attr.flavor == FL_MODULE) || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns))) { - t = SUCCESS; + t = true; break; } @@ -2928,16 +2925,16 @@ check_restricted (gfc_expr *e) case EXPR_NULL: case EXPR_CONSTANT: - t = SUCCESS; + t = true; break; case EXPR_SUBSTRING: t = gfc_specification_expr (e->ref->u.ss.start); - if (t == FAILURE) + if (!t) break; t = gfc_specification_expr (e->ref->u.ss.end); - if (t == SUCCESS) + if (t) t = gfc_simplify_expr (e, 0); break; @@ -2959,21 +2956,21 @@ check_restricted (gfc_expr *e) /* Check to see that an expression is a specification expression. If - we return FAILURE, an error has been generated. */ + we return false, an error has been generated. */ -gfc_try +bool gfc_specification_expr (gfc_expr *e) { gfc_component *comp; if (e == NULL) - return SUCCESS; + return true; if (e->ts.type != BT_INTEGER) { gfc_error ("Expression at %L must be of INTEGER type, found %s", &e->where, gfc_basic_typename (e->ts.type)); - return FAILURE; + return false; } comp = gfc_get_proc_ptr_comp (e); @@ -2987,17 +2984,17 @@ gfc_specification_expr (gfc_expr *e) e->symtree->n.sym->name, &e->where); /* Prevent repeat error messages. */ e->symtree->n.sym->attr.pure = 1; - return FAILURE; + return false; } if (e->rank != 0) { gfc_error ("Expression at %L must be scalar", &e->where); - return FAILURE; + return false; } - if (gfc_simplify_expr (e, 0) == FAILURE) - return FAILURE; + if (!gfc_simplify_expr (e, 0)) + return false; return check_restricted (e); } @@ -3007,18 +3004,18 @@ gfc_specification_expr (gfc_expr *e) /* Given two expressions, make sure that the arrays are conformable. */ -gfc_try +bool gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, ...) { int op1_flag, op2_flag, d; mpz_t op1_size, op2_size; - gfc_try t; + bool t; va_list argp; char buffer[240]; if (op1->rank == 0 || op2->rank == 0) - return SUCCESS; + return true; va_start (argp, optype_msgid); vsnprintf (buffer, 240, optype_msgid, argp); @@ -3028,15 +3025,15 @@ gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, . { gfc_error ("Incompatible ranks in %s (%d and %d) at %L", _(buffer), op1->rank, op2->rank, &op1->where); - return FAILURE; + return false; } - t = SUCCESS; + t = true; for (d = 0; d < op1->rank; d++) { - op1_flag = gfc_array_dimen_size (op1, d, &op1_size) == SUCCESS; - op2_flag = gfc_array_dimen_size (op2, d, &op2_size) == SUCCESS; + op1_flag = gfc_array_dimen_size(op1, d, &op1_size); + op2_flag = gfc_array_dimen_size(op2, d, &op2_size); if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0) { @@ -3045,7 +3042,7 @@ gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, . (int) mpz_get_si (op1_size), (int) mpz_get_si (op2_size)); - t = FAILURE; + t = false; } if (op1_flag) @@ -3053,18 +3050,18 @@ gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, . if (op2_flag) mpz_clear (op2_size); - if (t == FAILURE) - return FAILURE; + if (!t) + return false; } - return SUCCESS; + return true; } /* Given an assignable expression and an arbitrary expression, make sure that the assignment can take place. */ -gfc_try +bool gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) { gfc_symbol *sym; @@ -3130,7 +3127,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) if (bad_proc) { gfc_error ("'%s' at %L is not a VALUE", sym->name, &lvalue->where); - return FAILURE; + return false; } } @@ -3138,26 +3135,26 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) { gfc_error ("Incompatible ranks %d and %d in assignment at %L", lvalue->rank, rvalue->rank, &lvalue->where); - return FAILURE; + return false; } if (lvalue->ts.type == BT_UNKNOWN) { gfc_error ("Variable type is UNKNOWN in assignment at %L", &lvalue->where); - return FAILURE; + return false; } if (rvalue->expr_type == EXPR_NULL) { if (has_pointer && (ref == NULL || ref->next == NULL) && lvalue->symtree->n.sym->attr.data) - return SUCCESS; + return true; else { gfc_error ("NULL appears on right-hand side in assignment at %L", &rvalue->where); - return FAILURE; + return false; } } @@ -3169,21 +3166,20 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) /* Check size of array assignments. */ if (lvalue->rank != 0 && rvalue->rank != 0 - && gfc_check_conformance (lvalue, rvalue, "array assignment") != SUCCESS) - return FAILURE; + && !gfc_check_conformance (lvalue, rvalue, "array assignment")) + return false; if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER && lvalue->symtree->n.sym->attr.data - && gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to " - "initialize non-integer variable '%s'", - &rvalue->where, lvalue->symtree->n.sym->name) - == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to " + "initialize non-integer variable '%s'", + &rvalue->where, lvalue->symtree->n.sym->name)) + return false; else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data - && gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside " - "a DATA statement and outside INT/REAL/DBLE/CMPLX", - &rvalue->where) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside " + "a DATA statement and outside INT/REAL/DBLE/CMPLX", + &rvalue->where)) + return false; /* Handle the case of a BOZ literal on the RHS. */ if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER) @@ -3194,7 +3190,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) "non-integer symbol '%s'", &rvalue->where, lvalue->symtree->n.sym->name); if (!gfc_convert_boz (rvalue, &lvalue->ts)) - return FAILURE; + return false; if ((rc = gfc_range_check (rvalue)) != ARITH_OK) { if (rc == ARITH_UNDERFLOW) @@ -3209,7 +3205,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L" ". This check can be disabled with the option " "-fno-range-check", &rvalue->where); - return FAILURE; + return false; } } @@ -3261,7 +3257,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) } if (gfc_compare_types (&lvalue->ts, &rvalue->ts)) - return SUCCESS; + return true; /* Only DATA Statements come here. */ if (!conform) @@ -3270,16 +3266,16 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) converted to any other type. */ if ((gfc_numeric_ts (&lvalue->ts) && gfc_numeric_ts (&rvalue->ts)) || rvalue->ts.type == BT_HOLLERITH) - return SUCCESS; + return true; if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL) - return SUCCESS; + return true; gfc_error ("Incompatible types in DATA statement at %L; attempted " "conversion of %s to %s", &lvalue->where, gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts)); - return FAILURE; + return false; } /* Assignment is the only case where character variables of different @@ -3289,7 +3285,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) if (lvalue->ts.kind != rvalue->ts.kind) gfc_convert_chartype (rvalue, &lvalue->ts); - return SUCCESS; + return true; } return gfc_convert_type (rvalue, &lvalue->ts, 1); @@ -3300,7 +3296,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) we only check rvalue if it's not an assignment to NULL() or a NULLIFY statement. */ -gfc_try +bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { symbol_attribute attr, lhs_attr; @@ -3313,7 +3309,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Pointer assignment target is not a POINTER at %L", &lvalue->where); - return FAILURE; + return false; } if (lhs_attr.flavor == FL_PROCEDURE && lhs_attr.use_assoc @@ -3322,7 +3318,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) gfc_error ("'%s' in the pointer assignment at %L cannot be an " "l-value since it is a procedure", lvalue->symtree->n.sym->name, &lvalue->where); - return FAILURE; + return false; } proc_pointer = lvalue->symtree->n.sym->attr.proc_pointer; @@ -3344,14 +3340,13 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Expected bounds specification for '%s' at %L", lvalue->symtree->n.sym->name, &lvalue->where); - return FAILURE; + return false; } - if (gfc_notify_std (GFC_STD_F2003,"Bounds " - "specification for '%s' in pointer assignment " - "at %L", lvalue->symtree->n.sym->name, - &lvalue->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2003, "Bounds specification " + "for '%s' in pointer assignment at %L", + lvalue->symtree->n.sym->name, &lvalue->where)) + return false; /* When bounds are given, all lbounds are necessary and either all or none of the upper bounds; no strides are allowed. If the @@ -3363,13 +3358,13 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Lower bound has to be present at %L", &lvalue->where); - return FAILURE; + return false; } if (ref->u.ar.stride[dim]) { gfc_error ("Stride must not be present at %L", &lvalue->where); - return FAILURE; + return false; } if (dim == 0) @@ -3381,7 +3376,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Either all or none of the upper bounds" " must be specified at %L", &lvalue->where); - return FAILURE; + return false; } } } @@ -3395,7 +3390,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) kind, etc for lvalue and rvalue must match, and rvalue must be a pure variable if we're in a pure function. */ if (rvalue->expr_type == EXPR_NULL && rvalue->ts.type == BT_UNKNOWN) - return SUCCESS; + return true; /* F2008, C723 (pointer) and C726 (proc-pointer); for PURE also C1283. */ if (lvalue->expr_type == EXPR_VARIABLE @@ -3407,7 +3402,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Pointer object at %L shall not have a coindex", &lvalue->where); - return FAILURE; + return false; } } @@ -3428,7 +3423,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Invalid procedure pointer assignment at %L", &rvalue->where); - return FAILURE; + return false; } if (rvalue->expr_type == EXPR_VARIABLE && !attr.proc_pointer) { @@ -3453,7 +3448,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) gfc_error ("Function result '%s' is invalid as proc-target " "in procedure pointer assignment at %L", sym->name, &rvalue->where); - return FAILURE; + return false; } } } @@ -3462,7 +3457,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) gfc_error ("Abstract interface '%s' is invalid " "in procedure pointer assignment at %L", rvalue->symtree->name, &rvalue->where); - return FAILURE; + return false; } /* Check for F08:C729. */ if (attr.flavor == FL_PROCEDURE) @@ -3472,20 +3467,19 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) gfc_error ("Statement function '%s' is invalid " "in procedure pointer assignment at %L", rvalue->symtree->name, &rvalue->where); - return FAILURE; + return false; } if (attr.proc == PROC_INTERNAL && - gfc_notify_std (GFC_STD_F2008, "Internal procedure " - "'%s' is invalid in procedure pointer assignment " - "at %L", rvalue->symtree->name, &rvalue->where) - == FAILURE) - return FAILURE; + !gfc_notify_std(GFC_STD_F2008, "Internal procedure '%s' " + "is invalid in procedure pointer assignment " + "at %L", rvalue->symtree->name, &rvalue->where)) + return false; if (attr.intrinsic && gfc_intrinsic_actual_ok (rvalue->symtree->name, attr.subroutine) == 0) { gfc_error ("Intrinsic '%s' at %L is invalid in procedure pointer " "assignment", rvalue->symtree->name, &rvalue->where); - return FAILURE; + return false; } } /* Check for F08:C730. */ @@ -3494,7 +3488,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) gfc_error ("Nonintrinsic elemental procedure '%s' is invalid " "in procedure pointer assignment at %L", rvalue->symtree->name, &rvalue->where); - return FAILURE; + return false; } /* Ensure that the calling convention is the same. As other attributes @@ -3517,7 +3511,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) gfc_error ("Mismatch in the procedure pointer assignment " "at %L: mismatch in the calling convention", &rvalue->where); - return FAILURE; + return false; } } @@ -3560,14 +3554,14 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) s2 = s2->ts.interface; if (s1 == s2 || !s1 || !s2) - return SUCCESS; + return true; if (!gfc_compare_interfaces (s1, s2, name, 0, 1, err, sizeof(err), NULL, NULL)) { gfc_error ("Interface mismatch in procedure pointer assignment " "at %L: %s", &rvalue->where, err); - return FAILURE; + return false; } if (!gfc_compare_interfaces (s2, s1, name, 0, 1, @@ -3575,10 +3569,10 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Interface mismatch in procedure pointer assignment " "at %L: %s", &rvalue->where, err); - return FAILURE; + return false; } - return SUCCESS; + return true; } if (!gfc_compare_types (&lvalue->ts, &rvalue->ts)) @@ -3599,20 +3593,20 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) "attempted assignment of %s to %s", &lvalue->where, gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts)); - return FAILURE; + return false; } if (lvalue->ts.type != BT_CLASS && lvalue->ts.kind != rvalue->ts.kind) { gfc_error ("Different kind type parameters in pointer " "assignment at %L", &lvalue->where); - return FAILURE; + return false; } if (lvalue->rank != rvalue->rank && !rank_remap) { gfc_error ("Different ranks in pointer assignment at %L", &lvalue->where); - return FAILURE; + return false; } /* Make sure the vtab is present. */ @@ -3628,15 +3622,15 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) /* If this can be determined, check that the target must be at least as large as the pointer assigned to it is. */ - if (gfc_array_size (lvalue, &lsize) == SUCCESS - && gfc_array_size (rvalue, &rsize) == SUCCESS + if (gfc_array_size (lvalue, &lsize) + && gfc_array_size (rvalue, &rsize) && mpz_cmp (rsize, lsize) < 0) { gfc_error ("Rank remapping target is smaller than size of the" " pointer (%ld < %ld) at %L", mpz_get_si (rsize), mpz_get_si (lsize), &lvalue->where); - return FAILURE; + return false; } /* The target must be either rank one or it must be simply contiguous @@ -3647,24 +3641,23 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Rank remapping target must be rank 1 or" " simply contiguous at %L", &rvalue->where); - return FAILURE; + return false; } - if (gfc_notify_std (GFC_STD_F2008, "Rank remapping" - " target is not rank 1 at %L", &rvalue->where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2008, "Rank remapping target is not " + "rank 1 at %L", &rvalue->where)) + return false; } } /* Now punt if we are dealing with a NULLIFY(X) or X = NULL(X). */ if (rvalue->expr_type == EXPR_NULL) - return SUCCESS; + return true; if (lvalue->ts.type == BT_CHARACTER) { - gfc_try t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment"); - if (t == FAILURE) - return FAILURE; + bool t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment"); + if (!t) + return false; } if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue)) @@ -3677,14 +3670,14 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) gfc_error ("Target expression in pointer assignment " "at %L must deliver a pointer result", &rvalue->where); - return FAILURE; + return false; } if (!attr.target && !attr.pointer) { gfc_error ("Pointer assignment target is neither TARGET " "nor POINTER at %L", &rvalue->where); - return FAILURE; + return false; } if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym)) @@ -3701,7 +3694,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Pointer assignment with vector subscript " "on rhs at %L", &rvalue->where); - return FAILURE; + return false; } if (attr.is_protected && attr.use_assoc @@ -3709,7 +3702,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Pointer assignment target has PROTECTED " "attribute at %L", &rvalue->where); - return FAILURE; + return false; } /* F2008, C725. For PURE also C1283. */ @@ -3722,7 +3715,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { gfc_error ("Data target at %L shall not have a coindex", &rvalue->where); - return FAILURE; + return false; } } @@ -3761,18 +3754,18 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) "pointer target", &lvalue->where); } - return SUCCESS; + return true; } /* Relative of gfc_check_assign() except that the lvalue is a single symbol. Used for initialization assignments. */ -gfc_try +bool gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) { gfc_expr lvalue; - gfc_try r; + bool r; bool pointer, proc_pointer; memset (&lvalue, '\0', sizeof (gfc_expr)); @@ -3812,7 +3805,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) free (lvalue.symtree); - if (r == FAILURE) + if (!r) return r; if (pointer && rvalue->expr_type != EXPR_NULL) @@ -3824,13 +3817,13 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) { gfc_error ("Pointer initialization target at %L " "must not be ALLOCATABLE", &rvalue->where); - return FAILURE; + return false; } if (!attr.target || attr.pointer) { gfc_error ("Pointer initialization target at %L " "must have the TARGET attribute", &rvalue->where); - return FAILURE; + return false; } if (!attr.save && rvalue->expr_type == EXPR_VARIABLE @@ -3845,7 +3838,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) { gfc_error ("Pointer initialization target at %L " "must have the SAVE attribute", &rvalue->where); - return FAILURE; + return false; } } @@ -3857,11 +3850,11 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) { gfc_error ("Procedure pointer initialization target at %L " "may not be a procedure pointer", &rvalue->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } @@ -4275,7 +4268,7 @@ static bool expr_check_typed_help (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED, int* f ATTRIBUTE_UNUSED) { - gfc_try t; + bool t; if (e->expr_type != EXPR_VARIABLE) return false; @@ -4284,10 +4277,10 @@ expr_check_typed_help (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED, t = gfc_check_symbol_typed (e->symtree->n.sym, check_typed_ns, true, e->where); - return (t == FAILURE); + return (!t); } -gfc_try +bool gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict) { bool error_found; @@ -4301,12 +4294,12 @@ gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict) if (e->expr_type == EXPR_OP) { - gfc_try t = SUCCESS; + bool t = true; gcc_assert (e->value.op.op1); t = gfc_expr_check_typed (e->value.op.op1, ns, strict); - if (t == SUCCESS && e->value.op.op2) + if (t && e->value.op.op2) t = gfc_expr_check_typed (e->value.op.op2, ns, strict); return t; @@ -4317,7 +4310,7 @@ gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict) check_typed_ns = ns; error_found = gfc_traverse_expr (e, NULL, &expr_check_typed_help, 0); - return error_found ? FAILURE : SUCCESS; + return error_found ? false : true; } @@ -4676,9 +4669,9 @@ gfc_build_intrinsic_call (gfc_namespace *ns, gfc_isym_id id, const char* name, variables), some checks are not performed. Optionally, a possible error message can be suppressed if context is NULL - and just the return status (SUCCESS / FAILURE) be requested. */ + and just the return status (true / false) be requested. */ -gfc_try +bool gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, bool own_scope, const char* context) { @@ -4711,7 +4704,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (context) gfc_error ("Fortran 2008: Pointer functions in variable definition" " context (%s) at %L", context, &e->where); - return FAILURE; + return false; } } else if (e->expr_type != EXPR_VARIABLE) @@ -4719,7 +4712,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (context) gfc_error ("Non-variable expression in variable definition context (%s)" " at %L", context, &e->where); - return FAILURE; + return false; } if (!pointer && sym->attr.flavor == FL_PARAMETER) @@ -4727,7 +4720,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (context) gfc_error ("Named constant '%s' in variable definition context (%s)" " at %L", sym->name, context, &e->where); - return FAILURE; + return false; } if (!pointer && sym->attr.flavor != FL_VARIABLE && !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result) @@ -4736,7 +4729,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (context) gfc_error ("'%s' in variable definition context (%s) at %L is not" " a variable", sym->name, context, &e->where); - return FAILURE; + return false; } /* Find out whether the expr is a pointer; this also means following @@ -4747,7 +4740,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (context) gfc_error ("Non-POINTER in pointer association context (%s)" " at %L", context, &e->where); - return FAILURE; + return false; } /* F2008, C1303. */ @@ -4760,7 +4753,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (context) gfc_error ("LOCK_TYPE in variable definition context (%s) at %L", context, &e->where); - return FAILURE; + return false; } /* INTENT(IN) dummy argument. Check this, unless the object itself is the @@ -4790,7 +4783,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, gfc_error ("Dummy argument '%s' with INTENT(IN) in pointer" " association context (%s) at %L", sym->name, context, &e->where); - return FAILURE; + return false; } if (!pointer && !is_pointer && !sym->attr.pointer) { @@ -4798,7 +4791,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, gfc_error ("Dummy argument '%s' with INTENT(IN) in variable" " definition context (%s) at %L", sym->name, context, &e->where); - return FAILURE; + return false; } } @@ -4811,7 +4804,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, gfc_error ("Variable '%s' is PROTECTED and can not appear in a" " pointer association context (%s) at %L", sym->name, context, &e->where); - return FAILURE; + return false; } if (!pointer && !is_pointer) { @@ -4819,7 +4812,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, gfc_error ("Variable '%s' is PROTECTED and can not appear in a" " variable definition context (%s) at %L", sym->name, context, &e->where); - return FAILURE; + return false; } } @@ -4831,7 +4824,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, gfc_error ("Variable '%s' can not appear in a variable definition" " context (%s) at %L in PURE procedure", sym->name, context, &e->where); - return FAILURE; + return false; } if (!pointer && context && gfc_implicit_pure (NULL) @@ -4895,12 +4888,11 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, " not be used in a variable definition context (%s)", name, &e->where, context); } - return FAILURE; + return false; } /* Target must be allowed to appear in a variable definition context. */ - if (gfc_check_vardef_context (assoc->target, pointer, false, false, NULL) - == FAILURE) + if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL)) { if (context) gfc_error ("Associate-name '%s' can not appear in a variable" @@ -4908,9 +4900,9 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, " at %L can not, either", name, context, &e->where, &assoc->target->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 60d790b..30cbfe59 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -221,7 +221,7 @@ gfc_init (void) gfc_init_1 (); - if (gfc_new_file () != SUCCESS) + if (!gfc_new_file ()) fatal_error ("can't open input file: %s", gfc_source_file); return true; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index b2d0116..9749314 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -588,7 +588,7 @@ cfe_expr_0 (gfc_expr **e, int *walk_subtrees, newvar = NULL; for (j=0; j<i; j++) { - if (gfc_dep_compare_functions(*(expr_array[i]), + if (gfc_dep_compare_functions (*(expr_array[i]), *(expr_array[j]), true) == 0) { if (newvar == NULL) @@ -936,7 +936,7 @@ optimize_assignment (gfc_code * c) remove_trim (rhs); /* Replace a = ' ' by a = '' to optimize away a memcpy. */ - if (is_empty_string(rhs)) + if (is_empty_string (rhs)) rhs->value.character.length = 0; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4ebe987..b033b74 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -95,14 +95,6 @@ typedef enum { M_READ, M_WRITE, M_PRINT, M_INQUIRE } io_kind; -/* The author remains confused to this day about the convention of - returning '0' for 'SUCCESS'... or was it the other way around? The - following enum makes things much more readable. We also start - values off at one instead of zero. */ - -typedef enum -{ SUCCESS = 1, FAILURE } -gfc_try; /* These are flags for identifying whether we are reading a character literal between quotes or normal source code. */ @@ -1626,16 +1618,16 @@ gfc_intrinsic_arg; typedef union { - gfc_try (*f0)(void); - gfc_try (*f1)(struct gfc_expr *); - gfc_try (*f1m)(gfc_actual_arglist *); - gfc_try (*f2)(struct gfc_expr *, struct gfc_expr *); - gfc_try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); - gfc_try (*f3ml)(gfc_actual_arglist *); - gfc_try (*f3red)(gfc_actual_arglist *); - gfc_try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, + bool (*f0)(void); + bool (*f1)(struct gfc_expr *); + bool (*f1m)(gfc_actual_arglist *); + bool (*f2)(struct gfc_expr *, struct gfc_expr *); + bool (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); + bool (*f3ml)(gfc_actual_arglist *); + bool (*f3red)(gfc_actual_arglist *); + bool (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); - gfc_try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, + bool (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *, struct gfc_expr *); } gfc_check_f; @@ -2432,7 +2424,7 @@ gfc_char_t gfc_peek_char (void); char gfc_peek_ascii_char (void); void gfc_error_recovery (void); void gfc_gobble_whitespace (void); -gfc_try gfc_new_file (void); +bool gfc_new_file (void); const char * gfc_read_orig_filename (const char *, const char **); extern gfc_source_form gfc_current_form; @@ -2505,7 +2497,7 @@ int gfc_error_check (void); int gfc_error_flag_test (void); notification gfc_notification_std (int); -gfc_try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); +bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); /* A general purpose syntax error. */ #define gfc_syntax_error(ST) \ @@ -2525,7 +2517,7 @@ arith gfc_check_integer_range (mpz_t p, int kind); bool gfc_check_character_range (gfc_char_t, int); /* trans-types.c */ -gfc_try gfc_check_any_c_kind (gfc_typespec *); +bool gfc_check_any_c_kind (gfc_typespec *); int gfc_validate_kind (bt, int, bool); int gfc_get_int_kind_from_width_isofortranenv (int size); int gfc_get_real_kind_from_width_isofortranenv (int size); @@ -2548,72 +2540,72 @@ extern int gfc_character_storage_size; /* symbol.c */ void gfc_clear_new_implicit (void); -gfc_try gfc_add_new_implicit_range (int, int); -gfc_try gfc_merge_new_implicit (gfc_typespec *); +bool gfc_add_new_implicit_range (int, int); +bool gfc_merge_new_implicit (gfc_typespec *); void gfc_set_implicit_none (void); void gfc_check_function_type (gfc_namespace *); bool gfc_is_intrinsic_typename (const char *); gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *); -gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *); +bool gfc_set_default_type (gfc_symbol *, int, gfc_namespace *); void gfc_set_sym_referenced (gfc_symbol *); -gfc_try gfc_add_attribute (symbol_attribute *, locus *); -gfc_try gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *); -gfc_try gfc_add_allocatable (symbol_attribute *, locus *); -gfc_try gfc_add_codimension (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_contiguous (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_external (symbol_attribute *, locus *); -gfc_try gfc_add_intrinsic (symbol_attribute *, locus *); -gfc_try gfc_add_optional (symbol_attribute *, locus *); -gfc_try gfc_add_pointer (symbol_attribute *, locus *); -gfc_try gfc_add_cray_pointer (symbol_attribute *, locus *); -gfc_try gfc_add_cray_pointee (symbol_attribute *, locus *); +bool gfc_add_attribute (symbol_attribute *, locus *); +bool gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *); +bool gfc_add_allocatable (symbol_attribute *, locus *); +bool gfc_add_codimension (symbol_attribute *, const char *, locus *); +bool gfc_add_contiguous (symbol_attribute *, const char *, locus *); +bool gfc_add_dimension (symbol_attribute *, const char *, locus *); +bool gfc_add_external (symbol_attribute *, locus *); +bool gfc_add_intrinsic (symbol_attribute *, locus *); +bool gfc_add_optional (symbol_attribute *, locus *); +bool gfc_add_pointer (symbol_attribute *, locus *); +bool gfc_add_cray_pointer (symbol_attribute *, locus *); +bool gfc_add_cray_pointee (symbol_attribute *, locus *); match gfc_mod_pointee_as (gfc_array_spec *); -gfc_try gfc_add_protected (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_result (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_save (symbol_attribute *, save_state, const char *, locus *); -gfc_try gfc_add_threadprivate (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_saved_common (symbol_attribute *, locus *); -gfc_try gfc_add_target (symbol_attribute *, locus *); -gfc_try gfc_add_dummy (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_generic (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_common (symbol_attribute *, locus *); -gfc_try gfc_add_in_common (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_data (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_in_namelist (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_sequence (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_elemental (symbol_attribute *, locus *); -gfc_try gfc_add_pure (symbol_attribute *, locus *); -gfc_try gfc_add_recursive (symbol_attribute *, locus *); -gfc_try gfc_add_function (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_asynchronous (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where); -gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where); - -gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *); -gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int); -gfc_try gfc_add_extension (symbol_attribute *, locus *); -gfc_try gfc_add_value (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *); -gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *); -gfc_try gfc_add_procedure (symbol_attribute *, procedure_type, +bool gfc_add_protected (symbol_attribute *, const char *, locus *); +bool gfc_add_result (symbol_attribute *, const char *, locus *); +bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *); +bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *); +bool gfc_add_saved_common (symbol_attribute *, locus *); +bool gfc_add_target (symbol_attribute *, locus *); +bool gfc_add_dummy (symbol_attribute *, const char *, locus *); +bool gfc_add_generic (symbol_attribute *, const char *, locus *); +bool gfc_add_common (symbol_attribute *, locus *); +bool gfc_add_in_common (symbol_attribute *, const char *, locus *); +bool gfc_add_in_equivalence (symbol_attribute *, const char *, locus *); +bool gfc_add_data (symbol_attribute *, const char *, locus *); +bool gfc_add_in_namelist (symbol_attribute *, const char *, locus *); +bool gfc_add_sequence (symbol_attribute *, const char *, locus *); +bool gfc_add_elemental (symbol_attribute *, locus *); +bool gfc_add_pure (symbol_attribute *, locus *); +bool gfc_add_recursive (symbol_attribute *, locus *); +bool gfc_add_function (symbol_attribute *, const char *, locus *); +bool gfc_add_subroutine (symbol_attribute *, const char *, locus *); +bool gfc_add_volatile (symbol_attribute *, const char *, locus *); +bool gfc_add_asynchronous (symbol_attribute *, const char *, locus *); +bool gfc_add_proc (symbol_attribute *attr, const char *name, locus *where); +bool gfc_add_abstract (symbol_attribute* attr, locus* where); + +bool gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *); +bool gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int); +bool gfc_add_extension (symbol_attribute *, locus *); +bool gfc_add_value (symbol_attribute *, const char *, locus *); +bool gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *); +bool gfc_add_entry (symbol_attribute *, const char *, locus *); +bool gfc_add_procedure (symbol_attribute *, procedure_type, const char *, locus *); -gfc_try gfc_add_intent (symbol_attribute *, sym_intent, locus *); -gfc_try gfc_add_explicit_interface (gfc_symbol *, ifsrc, +bool gfc_add_intent (symbol_attribute *, sym_intent, locus *); +bool gfc_add_explicit_interface (gfc_symbol *, ifsrc, gfc_formal_arglist *, locus *); -gfc_try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *); +bool gfc_add_type (gfc_symbol *, gfc_typespec *, locus *); void gfc_clear_attr (symbol_attribute *); -gfc_try gfc_missing_attr (symbol_attribute *, locus *); -gfc_try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *); +bool gfc_missing_attr (symbol_attribute *, locus *); +bool gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *); -gfc_try gfc_add_component (gfc_symbol *, const char *, gfc_component **); +bool gfc_add_component (gfc_symbol *, const char *, gfc_component **); gfc_symbol *gfc_use_derived (gfc_symbol *); gfc_symtree *gfc_use_derived_tree (gfc_symtree *); gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool); @@ -2621,7 +2613,7 @@ gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool); gfc_st_label *gfc_get_st_label (int); void gfc_free_st_label (gfc_st_label *); void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *); -gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type); +bool gfc_reference_st_label (gfc_st_label *, gfc_sl_type); gfc_namespace *gfc_get_namespace (gfc_namespace *, int); gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *); @@ -2637,11 +2629,11 @@ gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *); int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **); int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **); int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **); -gfc_try gfc_verify_c_interop (gfc_typespec *); -gfc_try gfc_verify_c_interop_param (gfc_symbol *); -gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *); -gfc_try verify_bind_c_derived_type (gfc_symbol *); -gfc_try verify_com_block_vars_c_interop (gfc_common_head *); +bool gfc_verify_c_interop (gfc_typespec *); +bool gfc_verify_c_interop_param (gfc_symbol *); +bool verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *); +bool verify_bind_c_derived_type (gfc_symbol *); +bool verify_com_block_vars_c_interop (gfc_common_head *); gfc_symtree *generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *, gfc_symtree *, bool); int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool); @@ -2683,7 +2675,7 @@ void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *); void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */ -gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus); +bool gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus); gfc_namespace* gfc_find_proc_namespace (gfc_namespace*); bool gfc_is_associate_pointer (gfc_symbol*); @@ -2704,9 +2696,9 @@ void gfc_intrinsic_done_1 (void); char gfc_type_letter (bt); gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *); -gfc_try gfc_convert_type (gfc_expr *, gfc_typespec *, int); -gfc_try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int); -gfc_try gfc_convert_chartype (gfc_expr *, gfc_typespec *); +bool gfc_convert_type (gfc_expr *, gfc_typespec *, int); +bool gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int); +bool gfc_convert_chartype (gfc_expr *, gfc_typespec *); int gfc_generic_intrinsic (const char *); int gfc_specific_intrinsic (const char *); bool gfc_is_intrinsic (gfc_symbol*, int, locus); @@ -2723,7 +2715,7 @@ match gfc_intrinsic_func_interface (gfc_expr *, int); match gfc_intrinsic_sub_interface (gfc_code *, int); void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool); -gfc_try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**, +bool gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**, bool, locus); /* match.c -- FIXME */ @@ -2755,13 +2747,13 @@ gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *); const char *gfc_extract_int (gfc_expr *, int *); bool is_subref_array (gfc_expr *); bool gfc_is_simply_contiguous (gfc_expr *, bool); -gfc_try gfc_check_init_expr (gfc_expr *); +bool gfc_check_init_expr (gfc_expr *); gfc_expr *gfc_build_conversion (gfc_expr *); void gfc_free_ref_list (gfc_ref *); void gfc_type_convert_binary (gfc_expr *, int); int gfc_is_constant_expr (gfc_expr *); -gfc_try gfc_simplify_expr (gfc_expr *, int); +bool gfc_simplify_expr (gfc_expr *, int); int gfc_has_vector_index (gfc_expr *); gfc_expr *gfc_get_expr (void); @@ -2784,15 +2776,15 @@ mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *); gfc_expr *gfc_copy_expr (gfc_expr *); gfc_ref* gfc_copy_ref (gfc_ref*); -gfc_try gfc_specification_expr (gfc_expr *); +bool gfc_specification_expr (gfc_expr *); int gfc_numeric_ts (gfc_typespec *); int gfc_kind_max (gfc_expr *, gfc_expr *); -gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3; -gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int); -gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *); -gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *); +bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3; +bool gfc_check_assign (gfc_expr *, gfc_expr *, int); +bool gfc_check_pointer_assign (gfc_expr *, gfc_expr *); +bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *); bool gfc_has_default_initializer (gfc_symbol *); gfc_expr *gfc_default_initializer (gfc_typespec *); @@ -2806,7 +2798,7 @@ bool gfc_traverse_expr (gfc_expr *, gfc_symbol *, bool (*)(gfc_expr *, gfc_symbol *, int*), int); void gfc_expr_set_symbols_referenced (gfc_expr *); -gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool); +bool gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool); gfc_component * gfc_get_proc_ptr_comp (gfc_expr *); bool gfc_is_proc_ptr_comp (gfc_expr *); @@ -2820,7 +2812,7 @@ bool gfc_has_ultimate_pointer (gfc_expr *); gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*, locus, unsigned, ...); -gfc_try gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*); +bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*); /* st.c */ @@ -2834,23 +2826,23 @@ void gfc_free_statements (gfc_code *); void gfc_free_association_list (gfc_association_list *); /* resolve.c */ -gfc_try gfc_resolve_expr (gfc_expr *); +bool gfc_resolve_expr (gfc_expr *); void gfc_resolve (gfc_namespace *); void gfc_resolve_blocks (gfc_code *, gfc_namespace *); int gfc_impure_variable (gfc_symbol *); int gfc_pure (gfc_symbol *); int gfc_implicit_pure (gfc_symbol *); int gfc_elemental (gfc_symbol *); -gfc_try gfc_resolve_iterator (gfc_iterator *, bool, bool); -gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int); -gfc_try gfc_resolve_index (gfc_expr *, int); -gfc_try gfc_resolve_dim_arg (gfc_expr *); +bool gfc_resolve_iterator (gfc_iterator *, bool, bool); +bool find_forall_index (gfc_expr *, gfc_symbol *, int); +bool gfc_resolve_index (gfc_expr *, int); +bool gfc_resolve_dim_arg (gfc_expr *); int gfc_is_formal_arg (void); void gfc_resolve_substring_charlen (gfc_expr *); match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *); gfc_expr *gfc_expr_to_initialize (gfc_expr *); bool gfc_type_is_extensible (gfc_symbol *); -gfc_try gfc_resolve_intrinsic (gfc_symbol *, locus *); +bool gfc_resolve_intrinsic (gfc_symbol *, locus *); /* array.c */ @@ -2859,31 +2851,31 @@ gfc_iterator *gfc_copy_iterator (gfc_iterator *); void gfc_free_array_spec (gfc_array_spec *); gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *); -gfc_try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *); +bool gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *); gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *); -gfc_try gfc_resolve_array_spec (gfc_array_spec *, int); +bool gfc_resolve_array_spec (gfc_array_spec *, int); int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *); void gfc_simplify_iterator_var (gfc_expr *); -gfc_try gfc_expand_constructor (gfc_expr *, bool); +bool gfc_expand_constructor (gfc_expr *, bool); int gfc_constant_ac (gfc_expr *); int gfc_expanded_ac (gfc_expr *); -gfc_try gfc_resolve_character_array_constructor (gfc_expr *); -gfc_try gfc_resolve_array_constructor (gfc_expr *); -gfc_try gfc_check_constructor_type (gfc_expr *); -gfc_try gfc_check_iter_variable (gfc_expr *); -gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *)); -gfc_try gfc_array_size (gfc_expr *, mpz_t *); -gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *); -gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *); +bool gfc_resolve_character_array_constructor (gfc_expr *); +bool gfc_resolve_array_constructor (gfc_expr *); +bool gfc_check_constructor_type (gfc_expr *); +bool gfc_check_iter_variable (gfc_expr *); +bool gfc_check_constructor (gfc_expr *, bool (*)(gfc_expr *)); +bool gfc_array_size (gfc_expr *, mpz_t *); +bool gfc_array_dimen_size (gfc_expr *, int, mpz_t *); +bool gfc_array_ref_shape (gfc_array_ref *, mpz_t *); gfc_array_ref *gfc_find_array_ref (gfc_expr *); tree gfc_conv_array_initializer (tree type, gfc_expr *); -gfc_try spec_size (gfc_array_spec *, mpz_t *); -gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *); +bool spec_size (gfc_array_spec *, mpz_t *); +bool spec_dimen_size (gfc_array_spec *, int, mpz_t *); int gfc_is_compile_time_shape (gfc_array_spec *); -gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *); +bool gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *); /* interface.c -- FIXME: some of these should be in symbol.c */ @@ -2893,15 +2885,15 @@ int gfc_compare_types (gfc_typespec *, gfc_typespec *); int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int, char *, int, const char *, const char *); void gfc_check_interfaces (gfc_namespace *); -gfc_try gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); +bool gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *); gfc_symbol *gfc_search_interface (gfc_interface *, int, gfc_actual_arglist **); match gfc_extend_expr (gfc_expr *); void gfc_free_formal_arglist (gfc_formal_arglist *); -gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *); -gfc_try gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus); -gfc_try gfc_add_interface (gfc_symbol *); +bool gfc_extend_assign (gfc_code *, gfc_namespace *); +bool gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus); +bool gfc_add_interface (gfc_symbol *); gfc_interface *gfc_current_interface_head (void); void gfc_set_current_interface_head (gfc_interface *); gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*); @@ -2909,23 +2901,23 @@ bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*); bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus); int gfc_has_vector_subscript (gfc_expr*); gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op); -gfc_try gfc_check_typebound_override (gfc_symtree*, gfc_symtree*); +bool gfc_check_typebound_override (gfc_symtree*, gfc_symtree*); /* io.c */ extern gfc_st_label format_asterisk; void gfc_free_open (gfc_open *); -gfc_try gfc_resolve_open (gfc_open *); +bool gfc_resolve_open (gfc_open *); void gfc_free_close (gfc_close *); -gfc_try gfc_resolve_close (gfc_close *); +bool gfc_resolve_close (gfc_close *); void gfc_free_filepos (gfc_filepos *); -gfc_try gfc_resolve_filepos (gfc_filepos *); +bool gfc_resolve_filepos (gfc_filepos *); void gfc_free_inquire (gfc_inquire *); -gfc_try gfc_resolve_inquire (gfc_inquire *); +bool gfc_resolve_inquire (gfc_inquire *); void gfc_free_dt (gfc_dt *); -gfc_try gfc_resolve_dt (gfc_dt *, locus *); +bool gfc_resolve_dt (gfc_dt *, locus *); void gfc_free_wait (gfc_wait *); -gfc_try gfc_resolve_wait (gfc_wait *); +bool gfc_resolve_wait (gfc_wait *); /* module.c */ void gfc_module_init_2 (void); @@ -2941,7 +2933,7 @@ match gfc_match_rvalue (gfc_expr **); match gfc_match_varspec (gfc_expr*, int, bool, bool); int gfc_check_digit (char, int); bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *); -gfc_try gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *, +bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *, gfc_expr **, gfc_actual_arglist **, bool); @@ -2962,7 +2954,7 @@ void gfc_delete_bbt (void *, void *, compare_fn); void gfc_dump_parse_tree (gfc_namespace *, FILE *); /* parse.c */ -gfc_try gfc_parse_file (void); +bool gfc_parse_file (void); void gfc_global_used (gfc_gsymbol *, locus *); gfc_namespace* gfc_build_block_ns (gfc_namespace *); @@ -2972,8 +2964,8 @@ int gfc_dep_compare_expr (gfc_expr *, gfc_expr *); bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *); /* check.c */ -gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*); -gfc_try gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*, +bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*); +bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*, size_t*, size_t*, size_t*); /* class.c */ @@ -2991,15 +2983,15 @@ bool gfc_is_class_scalar_expr (gfc_expr *); bool gfc_is_class_container_ref (gfc_expr *e); gfc_expr *gfc_class_null_initializer (gfc_typespec *, gfc_expr *); unsigned int gfc_hash_value (gfc_symbol *); -gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *, +bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *, gfc_array_spec **, bool); gfc_symbol *gfc_find_derived_vtab (gfc_symbol *); gfc_symbol *gfc_find_intrinsic_vtab (gfc_typespec *); -gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*, +gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, bool*, const char*, bool, locus*); -gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*, +gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, bool*, const char*, bool, locus*); -gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*, +gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, bool*, gfc_intrinsic_op, bool, locus*); gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 5741911..2cadd8b 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -213,7 +213,7 @@ gfc_match_interface (void) return MATCH_ERROR; 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.dummy) @@ -251,8 +251,7 @@ gfc_match_abstract_interface (void) { match m; - if (gfc_notify_std (GFC_STD_F2003, "ABSTRACT INTERFACE at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "ABSTRACT INTERFACE at %C")) return MATCH_ERROR; m = gfc_match_eos (); @@ -326,23 +325,23 @@ gfc_match_end_interface (void) /* The following if-statements are used to enforce C1202 from F2003. */ - if ((strcmp(s1, "==") == 0 && strcmp(s2, ".eq.") == 0) - || (strcmp(s1, ".eq.") == 0 && strcmp(s2, "==") == 0)) + if ((strcmp(s1, "==") == 0 && strcmp (s2, ".eq.") == 0) + || (strcmp(s1, ".eq.") == 0 && strcmp (s2, "==") == 0)) break; - if ((strcmp(s1, "/=") == 0 && strcmp(s2, ".ne.") == 0) - || (strcmp(s1, ".ne.") == 0 && strcmp(s2, "/=") == 0)) + if ((strcmp(s1, "/=") == 0 && strcmp (s2, ".ne.") == 0) + || (strcmp(s1, ".ne.") == 0 && strcmp (s2, "/=") == 0)) break; - if ((strcmp(s1, "<=") == 0 && strcmp(s2, ".le.") == 0) - || (strcmp(s1, ".le.") == 0 && strcmp(s2, "<=") == 0)) + if ((strcmp(s1, "<=") == 0 && strcmp (s2, ".le.") == 0) + || (strcmp(s1, ".le.") == 0 && strcmp (s2, "<=") == 0)) break; - if ((strcmp(s1, "<") == 0 && strcmp(s2, ".lt.") == 0) - || (strcmp(s1, ".lt.") == 0 && strcmp(s2, "<") == 0)) + if ((strcmp(s1, "<") == 0 && strcmp (s2, ".lt.") == 0) + || (strcmp(s1, ".lt.") == 0 && strcmp (s2, "<") == 0)) break; - if ((strcmp(s1, ">=") == 0 && strcmp(s2, ".ge.") == 0) - || (strcmp(s1, ".ge.") == 0 && strcmp(s2, ">=") == 0)) + if ((strcmp(s1, ">=") == 0 && strcmp (s2, ".ge.") == 0) + || (strcmp(s1, ".ge.") == 0 && strcmp (s2, ">=") == 0)) break; - if ((strcmp(s1, ">") == 0 && strcmp(s2, ".gt.") == 0) - || (strcmp(s1, ".gt.") == 0 && strcmp(s2, ">") == 0)) + if ((strcmp(s1, ">") == 0 && strcmp (s2, ".gt.") == 0) + || (strcmp(s1, ".gt.") == 0 && strcmp (s2, ">") == 0)) break; m = MATCH_ERROR; @@ -1019,19 +1018,19 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, /* Check if the characteristics of two dummy arguments match, cf. F08:12.3.2. */ -static gfc_try +static bool check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, bool type_must_agree, char *errmsg, int err_len) { if (s1 == NULL || s2 == NULL) - return s1 == s2 ? SUCCESS : FAILURE; + return s1 == s2 ? true : false; /* Check type and rank. */ if (type_must_agree && !compare_type_rank (s2, s1)) { snprintf (errmsg, err_len, "Type/rank mismatch in argument '%s'", s1->name); - return FAILURE; + return false; } /* Check INTENT. */ @@ -1039,7 +1038,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "INTENT mismatch in argument '%s'", s1->name); - return FAILURE; + return false; } /* Check OPTIONAL attribute. */ @@ -1047,7 +1046,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "OPTIONAL mismatch in argument '%s'", s1->name); - return FAILURE; + return false; } /* Check ALLOCATABLE attribute. */ @@ -1055,7 +1054,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "ALLOCATABLE mismatch in argument '%s'", s1->name); - return FAILURE; + return false; } /* Check POINTER attribute. */ @@ -1063,7 +1062,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "POINTER mismatch in argument '%s'", s1->name); - return FAILURE; + return false; } /* Check TARGET attribute. */ @@ -1071,7 +1070,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "TARGET mismatch in argument '%s'", s1->name); - return FAILURE; + return false; } /* FIXME: Do more comprehensive testing of attributes, like e.g. @@ -1086,7 +1085,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "Interface mismatch in dummy procedure " "'%s': %s", s1->name, err); - return FAILURE; + return false; } } @@ -1104,7 +1103,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, case -3: snprintf (errmsg, err_len, "Character length mismatch " "in argument '%s'", s1->name); - return FAILURE; + return false; case -2: /* FIXME: Implement a warning for this case. @@ -1132,7 +1131,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "Shape mismatch in argument '%s'", s1->name); - return FAILURE; + return false; } if (s1->as->type == AS_EXPLICIT) @@ -1152,7 +1151,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, case -3: snprintf (errmsg, err_len, "Shape mismatch in dimension %i of " "argument '%s'", i + 1, s1->name); - return FAILURE; + return false; case -2: /* FIXME: Implement a warning for this case. @@ -1172,14 +1171,14 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, } } - return SUCCESS; + return true; } /* Check if the characteristics of two function results match, cf. F08:12.3.3. */ -static gfc_try +static bool check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, char *errmsg, int err_len) { @@ -1189,13 +1188,13 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, r2 = s2->result ? s2->result : s2; if (r1->ts.type == BT_UNKNOWN) - return SUCCESS; + return true; /* Check type and rank. */ if (!compare_type_rank (r1, r2)) { snprintf (errmsg, err_len, "Type/rank mismatch in function result"); - return FAILURE; + return false; } /* Check ALLOCATABLE attribute. */ @@ -1203,7 +1202,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "ALLOCATABLE attribute mismatch in " "function result"); - return FAILURE; + return false; } /* Check POINTER attribute. */ @@ -1211,7 +1210,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "POINTER attribute mismatch in " "function result"); - return FAILURE; + return false; } /* Check CONTIGUOUS attribute. */ @@ -1219,7 +1218,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "CONTIGUOUS attribute mismatch in " "function result"); - return FAILURE; + return false; } /* Check PROCEDURE POINTER attribute. */ @@ -1227,7 +1226,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "PROCEDURE POINTER mismatch in " "function result"); - return FAILURE; + return false; } /* Check string length. */ @@ -1237,7 +1236,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, { snprintf (errmsg, err_len, "Character length mismatch " "in function result"); - return FAILURE; + return false; } if (r1->ts.u.cl->length) @@ -1251,7 +1250,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, case -3: snprintf (errmsg, err_len, "Character length mismatch " "in function result"); - return FAILURE; + return false; case -2: /* FIXME: Implement a warning for this case. @@ -1279,7 +1278,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, if (r1->as->type != r2->as->type) { snprintf (errmsg, err_len, "Shape mismatch in function result"); - return FAILURE; + return false; } if (r1->as->type == AS_EXPLICIT) @@ -1299,7 +1298,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, case -3: snprintf (errmsg, err_len, "Shape mismatch in dimension %i of " "function result", i + 1); - return FAILURE; + return false; case -2: /* FIXME: Implement a warning for this case. @@ -1318,7 +1317,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, } } - return SUCCESS; + return true; } @@ -1362,8 +1361,7 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, if (s1->attr.function && s2->attr.function) { /* If both are functions, check result characteristics. */ - if (check_result_characteristics (s1, s2, errmsg, err_len) - == FAILURE) + if (!check_result_characteristics (s1, s2, errmsg, err_len)) return 0; } @@ -1423,8 +1421,8 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, if (strict_flag) { /* Check all characteristics. */ - if (check_dummy_characteristics (f1->sym, f2->sym, - true, errmsg, err_len) == FAILURE) + if (!check_dummy_characteristics (f1->sym, f2->sym, true, + errmsg, err_len)) return 0; } else if (!compare_type_rank (f2->sym, f1->sym)) @@ -1491,9 +1489,9 @@ check_interface0 (gfc_interface *p, const char *interface_name) /* F2003, C1207. F2008, C1207. */ if (p->sym->attr.proc == PROC_INTERNAL - && gfc_notify_std (GFC_STD_F2008, "Internal procedure " - "'%s' in %s at %L", p->sym->name, interface_name, - &p->sym->declared_at) == FAILURE) + && !gfc_notify_std (GFC_STD_F2008, "Internal procedure " + "'%s' in %s at %L", p->sym->name, + interface_name, &p->sym->declared_at)) return 1; } p = psave; @@ -1879,7 +1877,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, gfc_add_function (&act_sym->attr, act_sym->name, &act_sym->declared_at); if (act_sym->ts.type == BT_UNKNOWN - && gfc_set_default_type (act_sym, 1, act_sym->ns) == FAILURE) + && !gfc_set_default_type (act_sym, 1, act_sym->ns)) return 0; } else if (formal->attr.subroutine && !act_sym->attr.subroutine) @@ -2478,7 +2476,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, /* Make sure that intrinsic vtables exist for calls to unlimited polymorphic formal arguments. */ - if (UNLIMITED_POLY(f->sym) + if (UNLIMITED_POLY (f->sym) && a->expr->ts.type != BT_DERIVED && a->expr->ts.type != BT_CLASS) gfc_find_intrinsic_vtab (&a->expr->ts); @@ -2528,7 +2526,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_error ("Actual argument at %L to assumed-type dummy is of " "derived type with type-bound or FINAL procedures", &a->expr->where); - return FAILURE; + return false; } } @@ -2741,11 +2739,9 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (((f->sym->ts.type == BT_CLASS && f->sym->attr.class_ok && CLASS_DATA (f->sym)->attr.class_pointer) || (f->sym->ts.type != BT_CLASS && f->sym->attr.pointer)) - && gfc_check_vardef_context (a->expr, true, false, false, context) - == FAILURE) + && !gfc_check_vardef_context (a->expr, true, false, false, context)) return 0; - if (gfc_check_vardef_context (a->expr, false, false, false, context) - == FAILURE) + if (!gfc_check_vardef_context (a->expr, false, false, false, context)) return 0; } @@ -2919,9 +2915,9 @@ pair_cmp (const void *p1, const void *p2) /* Given two expressions from some actual arguments, test whether they refer to the same expression. The analysis is conservative. - Returning FAILURE will produce no warning. */ + Returning false will produce no warning. */ -static gfc_try +static bool compare_actual_expr (gfc_expr *e1, gfc_expr *e2) { const gfc_ref *r1, *r2; @@ -2930,39 +2926,39 @@ compare_actual_expr (gfc_expr *e1, gfc_expr *e2) || e1->expr_type != EXPR_VARIABLE || e2->expr_type != EXPR_VARIABLE || e1->symtree->n.sym != e2->symtree->n.sym) - return FAILURE; + return false; /* TODO: improve comparison, see expr.c:show_ref(). */ for (r1 = e1->ref, r2 = e2->ref; r1 && r2; r1 = r1->next, r2 = r2->next) { if (r1->type != r2->type) - return FAILURE; + return false; switch (r1->type) { case REF_ARRAY: if (r1->u.ar.type != r2->u.ar.type) - return FAILURE; + return false; /* TODO: At the moment, consider only full arrays; we could do better. */ if (r1->u.ar.type != AR_FULL || r2->u.ar.type != AR_FULL) - return FAILURE; + return false; break; case REF_COMPONENT: if (r1->u.c.component != r2->u.c.component) - return FAILURE; + return false; break; case REF_SUBSTRING: - return FAILURE; + return false; default: gfc_internal_error ("compare_actual_expr(): Bad component code"); } } if (!r1 && !r2) - return SUCCESS; - return FAILURE; + return true; + return false; } @@ -2970,7 +2966,7 @@ compare_actual_expr (gfc_expr *e1, gfc_expr *e2) another, check that identical actual arguments aren't not associated with some incompatible INTENTs. */ -static gfc_try +static bool check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) { sym_intent f1_intent, f2_intent; @@ -2978,7 +2974,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) gfc_actual_arglist *a1; size_t n, i, j; argpair *p; - gfc_try t = SUCCESS; + bool t = true; n = 0; for (f1 = f, a1 = a;; f1 = f1->next, a1 = a1->next) @@ -3015,7 +3011,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) gfc_internal_error ("check_some_aliasing(): corrupted data"); /* Are the expression the same? */ - if (compare_actual_expr (p[i].a->expr, p[j].a->expr) == FAILURE) + if (!compare_actual_expr (p[i].a->expr, p[j].a->expr)) break; f2_intent = p[j].f->sym->attr.intent; if ((f1_intent == INTENT_IN && f2_intent == INTENT_OUT) @@ -3026,7 +3022,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) gfc_intent_string (f1_intent), p[i].f->sym->name, gfc_intent_string (f2_intent), p[j].f->sym->name, &p[i].a->expr->where); - t = FAILURE; + t = false; } } } @@ -3039,7 +3035,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) another, check that they are compatible in the sense that intents are not mismatched. */ -static gfc_try +static bool check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) { sym_intent f_intent; @@ -3065,7 +3061,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) gfc_error ("Procedure argument at %L is local to a PURE " "procedure and has the POINTER attribute", &a->expr->where); - return FAILURE; + return false; } } @@ -3077,7 +3073,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) gfc_error ("Coindexed actual argument at %L in PURE procedure " "is passed to an INTENT(%s) argument", &a->expr->where, gfc_intent_string (f_intent)); - return FAILURE; + return false; } if ((f->sym->ts.type == BT_CLASS && f->sym->attr.class_ok @@ -3087,7 +3083,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) gfc_error ("Coindexed actual argument at %L in PURE procedure " "is passed to a POINTER dummy argument", &a->expr->where); - return FAILURE; + return false; } } @@ -3098,11 +3094,11 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) gfc_error ("Coindexed polymorphic actual argument at %L is passed " "polymorphic dummy argument '%s'", &a->expr->where, f->sym->name); - return FAILURE; + return false; } } - return SUCCESS; + return true; } @@ -3110,7 +3106,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) well, the actual argument list will also end up being properly sorted. */ -gfc_try +bool gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) { gfc_formal_arglist *dummy_args; @@ -3139,7 +3135,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) gfc_error("The pointer object '%s' at %L must have an explicit " "function interface or be declared as array", sym->name, where); - return FAILURE; + return false; } if (sym->attr.allocatable && !sym->attr.external) @@ -3147,14 +3143,14 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) gfc_error("The allocatable object '%s' at %L must have an explicit " "function interface or be declared as array", sym->name, where); - return FAILURE; + return false; } if (sym->attr.allocatable) { gfc_error("Allocatable function '%s' at %L must have an explicit " "function interface", sym->name, where); - return FAILURE; + return false; } for (a = *ap; a; a = a->next) @@ -3194,7 +3190,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) && a->expr->ts.type == BT_UNKNOWN) { gfc_error ("MOLD argument to NULL required at %L", &a->expr->where); - return FAILURE; + return false; } /* TS 29113, C407b. */ @@ -3203,25 +3199,25 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) { gfc_error ("Assumed-rank argument requires an explicit interface " "at %L", &a->expr->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } dummy_args = gfc_sym_get_dummy_args (sym); if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental, where)) - return FAILURE; + return false; - if (check_intents (dummy_args, *ap) == FAILURE) - return FAILURE; + if (!check_intents (dummy_args, *ap)) + return false; if (gfc_option.warn_aliasing) check_some_aliasing (dummy_args, *ap); - return SUCCESS; + return true; } @@ -3427,7 +3423,7 @@ matching_typebound_op (gfc_expr** tb_base, { gfc_typebound_proc* tb; gfc_symbol* derived; - gfc_try result; + bool result; while (base->expr->expr_type == EXPR_OP && base->expr->value.op.op == INTRINSIC_PARENTHESES) @@ -3462,7 +3458,7 @@ matching_typebound_op (gfc_expr** tb_base, /* This means we hit a PRIVATE operator which is use-associated and should thus not be seen. */ - if (result == FAILURE) + if (!result) tb = NULL; /* Look through the super-type hierarchy for a matching specific @@ -3653,13 +3649,13 @@ gfc_extend_expr (gfc_expr *e) a call to it and succeed. */ if (tbo) { - gfc_try result; + bool result; gcc_assert (tb_base); build_compcall_for_operator (e, actual, tb_base, tbo, gname); result = gfc_resolve_expr (e); - if (result == FAILURE) + if (!result) return MATCH_ERROR; return MATCH_YES; @@ -3681,7 +3677,7 @@ gfc_extend_expr (gfc_expr *e) e->value.function.name = NULL; e->user_operator = 1; - if (gfc_resolve_expr (e) == FAILURE) + if (!gfc_resolve_expr (e)) return MATCH_ERROR; return MATCH_YES; @@ -3690,10 +3686,10 @@ gfc_extend_expr (gfc_expr *e) /* Tries to replace an assignment code node with a subroutine call to the subroutine associated with the assignment operator. Return - SUCCESS if the node was replaced. On FAILURE, no error is + true if the node was replaced. On false, no error is generated. */ -gfc_try +bool gfc_extend_assign (gfc_code *c, gfc_namespace *ns) { gfc_actual_arglist *actual; @@ -3711,7 +3707,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) && (rhs->rank == 0 || rhs->rank == lhs->rank) && (lhs->ts.type == rhs->ts.type || (gfc_numeric_ts (&lhs->ts) && gfc_numeric_ts (&rhs->ts)))) - return FAILURE; + return false; actual = gfc_get_actual_arglist (); actual->expr = lhs; @@ -3753,12 +3749,12 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) /* c is resolved from the caller, so no need to do it here. */ - return SUCCESS; + return true; } free (actual->next); free (actual); - return FAILURE; + return false; } /* Replace the assignment with the call. */ @@ -3768,7 +3764,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) c->expr2 = NULL; c->ext.actual = actual; - return SUCCESS; + return true; } @@ -3776,7 +3772,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) the given interface list. Ambiguity isn't checked yet since module procedures can be present without interfaces. */ -gfc_try +bool gfc_check_new_interface (gfc_interface *base, gfc_symbol *new_sym, locus loc) { gfc_interface *ip; @@ -3787,17 +3783,17 @@ gfc_check_new_interface (gfc_interface *base, gfc_symbol *new_sym, locus loc) { gfc_error ("Entity '%s' at %L is already present in the interface", new_sym->name, &loc); - return FAILURE; + return false; } } - return SUCCESS; + return true; } /* Add a symbol to the current interface. */ -gfc_try +bool gfc_add_interface (gfc_symbol *new_sym) { gfc_interface **head, *intr; @@ -3808,7 +3804,7 @@ gfc_add_interface (gfc_symbol *new_sym) { case INTERFACE_NAMELESS: case INTERFACE_ABSTRACT: - return SUCCESS; + return true; case INTERFACE_INTRINSIC_OP: for (ns = current_interface.ns; ns; ns = ns->parent) @@ -3816,62 +3812,62 @@ gfc_add_interface (gfc_symbol *new_sym) { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: - if (gfc_check_new_interface (ns->op[INTRINSIC_EQ], new_sym, - gfc_current_locus) == FAILURE - || gfc_check_new_interface (ns->op[INTRINSIC_EQ_OS], new_sym, - gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (ns->op[INTRINSIC_EQ], new_sym, + gfc_current_locus) + || !gfc_check_new_interface (ns->op[INTRINSIC_EQ_OS], + new_sym, gfc_current_locus)) + return false; break; case INTRINSIC_NE: case INTRINSIC_NE_OS: - if (gfc_check_new_interface (ns->op[INTRINSIC_NE], new_sym, - gfc_current_locus) == FAILURE - || gfc_check_new_interface (ns->op[INTRINSIC_NE_OS], new_sym, - gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (ns->op[INTRINSIC_NE], new_sym, + gfc_current_locus) + || !gfc_check_new_interface (ns->op[INTRINSIC_NE_OS], + new_sym, gfc_current_locus)) + return false; break; case INTRINSIC_GT: case INTRINSIC_GT_OS: - if (gfc_check_new_interface (ns->op[INTRINSIC_GT], new_sym, - gfc_current_locus) == FAILURE - || gfc_check_new_interface (ns->op[INTRINSIC_GT_OS], new_sym, - gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (ns->op[INTRINSIC_GT], + new_sym, gfc_current_locus) + || !gfc_check_new_interface (ns->op[INTRINSIC_GT_OS], + new_sym, gfc_current_locus)) + return false; break; case INTRINSIC_GE: case INTRINSIC_GE_OS: - if (gfc_check_new_interface (ns->op[INTRINSIC_GE], new_sym, - gfc_current_locus) == FAILURE - || gfc_check_new_interface (ns->op[INTRINSIC_GE_OS], new_sym, - gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (ns->op[INTRINSIC_GE], + new_sym, gfc_current_locus) + || !gfc_check_new_interface (ns->op[INTRINSIC_GE_OS], + new_sym, gfc_current_locus)) + return false; break; case INTRINSIC_LT: case INTRINSIC_LT_OS: - if (gfc_check_new_interface (ns->op[INTRINSIC_LT], new_sym, - gfc_current_locus) == FAILURE - || gfc_check_new_interface (ns->op[INTRINSIC_LT_OS], new_sym, - gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (ns->op[INTRINSIC_LT], + new_sym, gfc_current_locus) + || !gfc_check_new_interface (ns->op[INTRINSIC_LT_OS], + new_sym, gfc_current_locus)) + return false; break; case INTRINSIC_LE: case INTRINSIC_LE_OS: - if (gfc_check_new_interface (ns->op[INTRINSIC_LE], new_sym, - gfc_current_locus) == FAILURE - || gfc_check_new_interface (ns->op[INTRINSIC_LE_OS], new_sym, - gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (ns->op[INTRINSIC_LE], + new_sym, gfc_current_locus) + || !gfc_check_new_interface (ns->op[INTRINSIC_LE_OS], + new_sym, gfc_current_locus)) + return false; break; default: - if (gfc_check_new_interface (ns->op[current_interface.op], new_sym, - gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (ns->op[current_interface.op], + new_sym, gfc_current_locus)) + return false; } head = ¤t_interface.ns->op[current_interface.op]; @@ -3884,18 +3880,18 @@ gfc_add_interface (gfc_symbol *new_sym) if (sym == NULL) continue; - if (gfc_check_new_interface (sym->generic, new_sym, gfc_current_locus) - == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (sym->generic, + new_sym, gfc_current_locus)) + return false; } head = ¤t_interface.sym->generic; break; case INTERFACE_USER_OP: - if (gfc_check_new_interface (current_interface.uop->op, new_sym, - gfc_current_locus) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (current_interface.uop->op, + new_sym, gfc_current_locus)) + return false; head = ¤t_interface.uop->op; break; @@ -3911,7 +3907,7 @@ gfc_add_interface (gfc_symbol *new_sym) intr->next = *head; *head = intr; - return SUCCESS; + return true; } @@ -3980,7 +3976,7 @@ gfc_free_formal_arglist (gfc_formal_arglist *p) /* Check that it is ok for the type-bound procedure 'proc' to override the procedure 'old', cf. F08:4.5.7.3. */ -gfc_try +bool gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { locus where; @@ -3998,7 +3994,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("Can't overwrite GENERIC '%s' at %L", old->name, &proc->n.tb->where); - return FAILURE; + return false; } where = proc->n.tb->where; @@ -4010,7 +4006,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L overrides a procedure binding declared" " NON_OVERRIDABLE", proc->name, &where); - return FAILURE; + return false; } /* It's an error to override a non-DEFERRED procedure with a DEFERRED one. */ @@ -4018,7 +4014,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L must not be DEFERRED as it overrides a" " non-DEFERRED binding", proc->name, &where); - return FAILURE; + return false; } /* If the overridden binding is PURE, the overriding must be, too. */ @@ -4026,7 +4022,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE", proc->name, &where); - return FAILURE; + return false; } /* If the overridden binding is ELEMENTAL, the overriding must be, too. If it @@ -4035,13 +4031,13 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be" " ELEMENTAL", proc->name, &where); - return FAILURE; + return false; } if (!old_target->attr.elemental && proc_target->attr.elemental) { gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not" " be ELEMENTAL, either", proc->name, &where); - return FAILURE; + return false; } /* If the overridden binding is a SUBROUTINE, the overriding must also be a @@ -4050,7 +4046,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a" " SUBROUTINE", proc->name, &where); - return FAILURE; + return false; } /* If the overridden binding is a FUNCTION, the overriding must also be a @@ -4061,15 +4057,15 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L overrides a FUNCTION and must also be a" " FUNCTION", proc->name, &where); - return FAILURE; + return false; } - if (check_result_characteristics (proc_target, old_target, - err, sizeof(err)) == FAILURE) + if (!check_result_characteristics (proc_target, old_target, err, + sizeof(err))) { gfc_error ("Result mismatch for the overriding procedure " "'%s' at %L: %s", proc->name, &where, err); - return FAILURE; + return false; } } @@ -4080,7 +4076,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be" " PRIVATE", proc->name, &where); - return FAILURE; + return false; } /* Compare the formal argument lists of both procedures. This is also abused @@ -4112,16 +4108,16 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) " to match the corresponding argument of the overridden" " procedure", proc_formal->sym->name, proc->name, &where, old_formal->sym->name); - return FAILURE; + return false; } check_type = proc_pass_arg != argpos && old_pass_arg != argpos; - if (check_dummy_characteristics (proc_formal->sym, old_formal->sym, - check_type, err, sizeof(err)) == FAILURE) + if (!check_dummy_characteristics (proc_formal->sym, old_formal->sym, + check_type, err, sizeof(err))) { gfc_error ("Argument mismatch for the overriding procedure " "'%s' at %L: %s", proc->name, &where, err); - return FAILURE; + return false; } ++argpos; @@ -4130,7 +4126,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L must have the same number of formal arguments as" " the overridden procedure", proc->name, &where); - return FAILURE; + return false; } /* If the overridden binding is NOPASS, the overriding one must also be @@ -4139,7 +4135,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L overrides a NOPASS binding and must also be" " NOPASS", proc->name, &where); - return FAILURE; + return false; } /* If the overridden binding is PASS(x), the overriding one must also be @@ -4150,7 +4146,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) { gfc_error ("'%s' at %L overrides a binding with PASS and must also be" " PASS", proc->name, &where); - return FAILURE; + return false; } if (proc_pass_arg != old_pass_arg) @@ -4158,9 +4154,9 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) gfc_error ("Passed-object dummy argument of '%s' at %L must be at" " the same position as the passed-object dummy argument of" " the overridden procedure", proc->name, &where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 64df296..c431279 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -178,7 +178,7 @@ find_char_conv (gfc_typespec *from, gfc_typespec *to) and call the proper check function rather than forcing each function to manipulate the argument list. */ -static gfc_try +static bool do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) { gfc_expr *a1, *a2, *a3, *a4, *a5; @@ -343,7 +343,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type static void add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (void), + bool (*check) (void), gfc_expr *(*simplify) (void), void (*resolve) (gfc_expr *)) { @@ -386,7 +386,7 @@ add_sym_0s (const char *name, gfc_isym_id id, int standard, static void add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *), + bool (*check) (gfc_expr *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1) @@ -411,7 +411,7 @@ add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty static void add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *), + bool (*check) (gfc_expr *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, @@ -436,7 +436,7 @@ add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl, static void add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, - int standard, gfc_try (*check) (gfc_expr *), + int standard, bool (*check) (gfc_expr *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1, sym_intent intent1) @@ -461,7 +461,7 @@ add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, static void add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_actual_arglist *), + bool (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_expr *, gfc_actual_arglist *), const char *a1, bt type1, int kind1, int optional1, @@ -488,7 +488,7 @@ add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt t static void add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *, gfc_expr *), + bool (*check) (gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, @@ -515,7 +515,7 @@ add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty static void add_sym_2_intent (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *, gfc_expr *), + bool (*check) (gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, @@ -543,7 +543,7 @@ add_sym_2_intent (const char *name, gfc_isym_id id, enum klass cl, static void add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *, gfc_expr *), + bool (*check) (gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1, @@ -571,7 +571,7 @@ add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type, static void add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *), + bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, @@ -600,7 +600,7 @@ add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty static void add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_actual_arglist *), + bool (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, @@ -629,7 +629,7 @@ add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt static void add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_actual_arglist *), + bool (*check) (gfc_actual_arglist *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), const char *a1, bt type1, int kind1, int optional1, @@ -658,7 +658,7 @@ add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt static void add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *), + bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), const char *a1, bt type1, int kind1, int optional1, @@ -688,7 +688,7 @@ add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type, static void add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), + bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, @@ -721,7 +721,7 @@ add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty static void add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), + bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), void (*resolve) (gfc_code *), @@ -754,7 +754,7 @@ add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, static void add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard, - gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, + bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), @@ -981,7 +981,7 @@ gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc) return false; /* See if this intrinsic is allowed in the current standard. */ - if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE) + if (!gfc_check_intrinsic_standard (isym, &symstd, false, loc)) { if (sym->attr.proc == PROC_UNKNOWN && gfc_option.warn_intrinsics_std) @@ -3574,9 +3574,9 @@ remove_nullargs (gfc_actual_arglist **ap) with the format arglist. Arguments that are not present are given a blank gfc_actual_arglist structure. If something is obviously wrong (say, a missing required argument) we abort sorting and - return FAILURE. */ + return false. */ -static gfc_try +static bool sort_actual (const char *name, gfc_actual_arglist **ap, gfc_intrinsic_arg *formal, locus *where) { @@ -3593,7 +3593,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap, a = actual; if (f == NULL && a == NULL) /* No arguments */ - return SUCCESS; + return true; for (;;) { /* Put the nonkeyword arguments in a 1:1 correspondence */ @@ -3615,7 +3615,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap, goto do_sort; gfc_error ("Too many arguments in call to '%s' at %L", name, where); - return FAILURE; + return false; keywords: /* Associate the remaining actual arguments, all of which have @@ -3634,14 +3634,14 @@ keywords: else gfc_error ("Can't find keyword named '%s' in call to '%s' at %L", a->name, name, where); - return FAILURE; + return false; } if (f->actual != NULL) { gfc_error ("Argument '%s' appears twice in call to '%s' at %L", f->name, name, where); - return FAILURE; + return false; } f->actual = a; @@ -3655,7 +3655,7 @@ optional: { gfc_error ("Missing actual argument '%s' in call to '%s' at %L", f->name, name, where); - return FAILURE; + return false; } } @@ -3669,7 +3669,7 @@ do_sort: if (f->actual && f->actual->label != NULL && f->ts.type) { gfc_error ("ALTERNATE RETURN not permitted at %L", where); - return FAILURE; + return false; } if (f->actual == NULL) @@ -3689,7 +3689,7 @@ do_sort: } actual->next = NULL; /* End the sorted argument list. */ - return SUCCESS; + return true; } @@ -3697,7 +3697,7 @@ do_sort: list. The lists are checked for agreement of type. We don't check for arrayness here. */ -static gfc_try +static bool check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym, int error_flag) { @@ -3730,7 +3730,7 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym, gfc_current_intrinsic, &actual->expr->where, gfc_typename (&formal->ts), gfc_typename (&actual->expr->ts)); - return FAILURE; + return false; } /* If the formal argument is INTENT([IN]OUT), check for definability. */ @@ -3741,13 +3741,12 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym, : NULL); /* No pointer arguments for intrinsics. */ - if (gfc_check_vardef_context (actual->expr, false, false, false, - context) == FAILURE) - return FAILURE; + if (!gfc_check_vardef_context (actual->expr, false, false, false, context)) + return false; } } - return SUCCESS; + return true; } @@ -3838,11 +3837,11 @@ resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e) /* Given an intrinsic symbol node and an expression node, call the simplification function (if there is one), perhaps replacing the - expression with something simpler. We return FAILURE on an error - of the simplification, SUCCESS if the simplification worked, even + expression with something simpler. We return false on an error + of the simplification, true if the simplification worked, even if nothing has changed in the expression itself. */ -static gfc_try +static bool do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e) { gfc_expr *result, *a1, *a2, *a3, *a4, *a5; @@ -3926,7 +3925,7 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e) finish: if (result == &gfc_bad_expr) - return FAILURE; + return false; if (result == NULL) resolve_intrinsic (specific, e); /* Must call at run-time */ @@ -3936,12 +3935,12 @@ finish: gfc_replace_expr (e, result); } - return SUCCESS; + return true; } /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of - error messages. This subroutine returns FAILURE if a subroutine + error messages. This subroutine returns false if a subroutine has more than MAX_INTRINSIC_ARGS, in which case the actual argument list cannot match any intrinsic. */ @@ -3965,14 +3964,14 @@ init_arglist (gfc_intrinsic_sym *isym) /* Given a pointer to an intrinsic symbol and an expression consisting of a function call, see if the function call is consistent with the - intrinsic's formal argument list. Return SUCCESS if the expression - and intrinsic match, FAILURE otherwise. */ + intrinsic's formal argument list. Return true if the expression + and intrinsic match, false otherwise. */ -static gfc_try +static bool check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) { gfc_actual_arglist *arg, **ap; - gfc_try t; + bool t; ap = &expr->value.function.actual; @@ -3985,9 +3984,8 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) || specific->check.f1m == gfc_check_min_max_double) return (*specific->check.f1m) (*ap); - if (sort_actual (specific->name, ap, specific->formal, - &expr->where) == FAILURE) - return FAILURE; + if (!sort_actual (specific->name, ap, specific->formal, &expr->where)) + return false; if (specific->check.f3ml == gfc_check_minloc_maxloc) /* This is special because we might have to reorder the argument list. */ @@ -4008,7 +4006,7 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) if (specific->check.f1 == NULL) { t = check_arglist (ap, specific, error_flag); - if (t == SUCCESS) + if (t) expr->ts = specific->ts; } else @@ -4016,7 +4014,7 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) } /* Check conformance of elemental intrinsics. */ - if (t == SUCCESS && specific->elemental) + if (t && specific->elemental) { int n = 0; gfc_expr *first_expr; @@ -4027,16 +4025,16 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) first_expr = arg->expr; for ( ; arg && arg->expr; arg = arg->next, n++) - if (gfc_check_conformance (first_expr, arg->expr, - "arguments '%s' and '%s' for " - "intrinsic '%s'", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic_arg[n]->name, - gfc_current_intrinsic) == FAILURE) - return FAILURE; + if (!gfc_check_conformance (first_expr, arg->expr, + "arguments '%s' and '%s' for " + "intrinsic '%s'", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic_arg[n]->name, + gfc_current_intrinsic)) + return false; } - if (t == FAILURE) + if (!t) remove_nullargs (ap); return t; @@ -4049,9 +4047,9 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) textual representation of the symbols standard status (like "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that can be used to construct a detailed warning/error message in case of - a FAILURE. */ + a false. */ -gfc_try +bool gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym, const char** symstd, bool silent, locus where) { @@ -4059,7 +4057,7 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym, /* For -fall-intrinsics, just succeed. */ if (gfc_option.flag_all_intrinsics) - return SUCCESS; + return true; /* Find the symbol's standard message for later usage. */ switch (isym->standard) @@ -4113,17 +4111,17 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym, gfc_warning ("Intrinsic '%s' (is %s) is used at %L", isym->name, _(symstd_msg), &where); - return SUCCESS; + return true; } /* If allowing the symbol's standard, succeed, too. */ if (gfc_option.allow_std & isym->standard) - return SUCCESS; + return true; /* Otherwise, fail. */ if (symstd) *symstd = _(symstd_msg); - return FAILURE; + return false; } @@ -4149,7 +4147,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) int flag; if (expr->value.function.isym != NULL) - return (do_simplify (expr->value.function.isym, expr) == FAILURE) + return (!do_simplify(expr->value.function.isym, expr)) ? MATCH_ERROR : MATCH_YES; if (!error_flag) @@ -4181,9 +4179,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE || isym->id == GFC_ISYM_CMPLX) && gfc_init_expr_flag - && gfc_notify_std (GFC_STD_F2003, "Function '%s' " - "as initialization expression at %L", name, - &expr->where) == FAILURE) + && !gfc_notify_std (GFC_STD_F2003, "Function '%s' as initialization " + "expression at %L", name, &expr->where)) { if (!error_flag) gfc_pop_suppress_errors (); @@ -4197,7 +4194,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) { init_arglist (isym); - if (isym->check.f1m (expr->value.function.actual) == SUCCESS) + if (isym->check.f1m(expr->value.function.actual)) goto got_specific; if (!error_flag) @@ -4218,7 +4215,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) { if (specific == isym) continue; - if (check_specific (specific, expr, 0) == SUCCESS) + if (check_specific (specific, expr, 0)) { gfc_pop_suppress_errors (); goto got_specific; @@ -4228,7 +4225,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) gfc_pop_suppress_errors (); - if (check_specific (isym, expr, error_flag) == FAILURE) + if (!check_specific (isym, expr, error_flag)) { if (!error_flag) gfc_pop_suppress_errors (); @@ -4244,7 +4241,7 @@ got_specific: if (!error_flag) gfc_pop_suppress_errors (); - if (do_simplify (specific, expr) == FAILURE) + if (!do_simplify (specific, expr)) return MATCH_ERROR; /* F95, 7.1.6.1, Initialization expressions @@ -4257,9 +4254,9 @@ got_specific: where each argument is an initialization expression */ if (gfc_init_expr_flag && isym->elemental && flag - && gfc_notify_std (GFC_STD_F2003, "Elemental function " - "as initialization expression with non-integer/non-" - "character arguments at %L", &expr->where) == FAILURE) + && !gfc_notify_std (GFC_STD_F2003, "Elemental function as " + "initialization expression with non-integer/non-" + "character arguments at %L", &expr->where)) return MATCH_ERROR; return MATCH_YES; @@ -4295,17 +4292,17 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag) init_arglist (isym); - if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE) + if (!sort_actual (name, &c->ext.actual, isym->formal, &c->loc)) goto fail; if (isym->check.f1 != NULL) { - if (do_check (isym, c->ext.actual) == FAILURE) + if (!do_check (isym, c->ext.actual)) goto fail; } else { - if (check_arglist (&c->ext.actual, isym, 1) == FAILURE) + if (!check_arglist (&c->ext.actual, isym, 1)) goto fail; } @@ -4343,7 +4340,7 @@ fail: /* Call gfc_convert_type() with warning enabled. */ -gfc_try +bool gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag) { return gfc_convert_type_warn (expr, ts, eflag, 1); @@ -4360,7 +4357,7 @@ gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag) 'wflag' controls the warning related to conversion. */ -gfc_try +bool gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) { gfc_intrinsic_sym *sym; @@ -4381,7 +4378,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) { /* Sometimes the RHS acquire the type. */ expr->ts = *ts; - return SUCCESS; + return true; } if (expr->ts.type == BT_UNKNOWN) @@ -4389,7 +4386,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED && gfc_compare_types (&expr->ts, ts)) - return SUCCESS; + return true; sym = find_conv (&expr->ts, ts); if (sym == NULL) @@ -4499,22 +4496,22 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) expr->ts = *ts; if (gfc_is_constant_expr (expr->value.function.actual->expr) - && do_simplify (sym, expr) == FAILURE) + && !do_simplify (sym, expr)) { if (eflag == 2) goto bad; - return FAILURE; /* Error already generated in do_simplify() */ + return false; /* Error already generated in do_simplify() */ } - return SUCCESS; + return true; bad: if (eflag == 1) { gfc_error ("Can't convert %s to %s at %L", gfc_typename (&from_ts), gfc_typename (ts), &expr->where); - return FAILURE; + return false; } gfc_internal_error ("Can't convert %s to %s at %L", @@ -4524,7 +4521,7 @@ bad: } -gfc_try +bool gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts) { gfc_intrinsic_sym *sym; @@ -4568,13 +4565,13 @@ gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts) expr->ts = *ts; if (gfc_is_constant_expr (expr->value.function.actual->expr) - && do_simplify (sym, expr) == FAILURE) + && !do_simplify (sym, expr)) { /* Error already generated in do_simplify() */ - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -4600,8 +4597,8 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func) /* If no intrinsic was found with this name or it's not included in the selected standard, everything's fine. */ - if (!isym || gfc_check_intrinsic_standard (isym, NULL, true, - sym->declared_at) == FAILURE) + if (!isym || !gfc_check_intrinsic_standard (isym, NULL, true, + sym->declared_at)) return; /* Emit the warning. */ diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 347d71d..363bf38 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -25,195 +25,195 @@ extern gfc_expr gfc_bad_expr; /* Check functions. */ -gfc_try gfc_check_a_ikind (gfc_expr *, gfc_expr *); -gfc_try gfc_check_a_xkind (gfc_expr *, gfc_expr *); -gfc_try gfc_check_a_p (gfc_expr *, gfc_expr *); -gfc_try gfc_check_x_yd (gfc_expr *, gfc_expr *); +bool gfc_check_a_ikind (gfc_expr *, gfc_expr *); +bool gfc_check_a_xkind (gfc_expr *, gfc_expr *); +bool gfc_check_a_p (gfc_expr *, gfc_expr *); +bool gfc_check_x_yd (gfc_expr *, gfc_expr *); -gfc_try gfc_check_abs (gfc_expr *); -gfc_try gfc_check_access_func (gfc_expr *, gfc_expr *); -gfc_try gfc_check_achar (gfc_expr *, gfc_expr *); -gfc_try gfc_check_all_any (gfc_expr *, gfc_expr *); -gfc_try gfc_check_allocated (gfc_expr *); -gfc_try gfc_check_associated (gfc_expr *, gfc_expr *); -gfc_try gfc_check_atan_2 (gfc_expr *, gfc_expr *); -gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *); -gfc_try gfc_check_atomic_def (gfc_expr *, gfc_expr *); -gfc_try gfc_check_atomic_ref (gfc_expr *, gfc_expr *); -gfc_try gfc_check_besn (gfc_expr *, gfc_expr *); -gfc_try gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *); -gfc_try gfc_check_bitfcn (gfc_expr *, gfc_expr *); -gfc_try gfc_check_char (gfc_expr *, gfc_expr *); -gfc_try gfc_check_chdir (gfc_expr *); -gfc_try gfc_check_chmod (gfc_expr *, gfc_expr *); -gfc_try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_complex (gfc_expr *, gfc_expr *); -gfc_try gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_ctime (gfc_expr *); -gfc_try gfc_check_datan2 (gfc_expr *, gfc_expr *); -gfc_try gfc_check_dcmplx (gfc_expr *, gfc_expr *); -gfc_try gfc_check_dble (gfc_expr *); -gfc_try gfc_check_digits (gfc_expr *); -gfc_try gfc_check_dot_product (gfc_expr *, gfc_expr *); -gfc_try gfc_check_dprod (gfc_expr *, gfc_expr *); -gfc_try gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_dtime_etime (gfc_expr *); -gfc_try gfc_check_fgetputc (gfc_expr *, gfc_expr *); -gfc_try gfc_check_fgetput (gfc_expr *); -gfc_try gfc_check_float (gfc_expr *); -gfc_try gfc_check_fstat (gfc_expr *, gfc_expr *); -gfc_try gfc_check_ftell (gfc_expr *); -gfc_try gfc_check_fn_c (gfc_expr *); -gfc_try gfc_check_fn_d (gfc_expr *); -gfc_try gfc_check_fn_r (gfc_expr *); -gfc_try gfc_check_fn_rc (gfc_expr *); -gfc_try gfc_check_fn_rc2008 (gfc_expr *); -gfc_try gfc_check_fnum (gfc_expr *); -gfc_try gfc_check_hostnm (gfc_expr *); -gfc_try gfc_check_huge (gfc_expr *); -gfc_try gfc_check_hypot (gfc_expr *, gfc_expr *); -gfc_try gfc_check_i (gfc_expr *); -gfc_try gfc_check_iand (gfc_expr *, gfc_expr *); -gfc_try gfc_check_and (gfc_expr *, gfc_expr *); -gfc_try gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_ichar_iachar (gfc_expr *, gfc_expr *); -gfc_try gfc_check_idnint (gfc_expr *); -gfc_try gfc_check_ieor (gfc_expr *, gfc_expr *); -gfc_try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_int (gfc_expr *, gfc_expr *); -gfc_try gfc_check_intconv (gfc_expr *); -gfc_try gfc_check_ior (gfc_expr *, gfc_expr *); -gfc_try gfc_check_irand (gfc_expr *); -gfc_try gfc_check_isatty (gfc_expr *); -gfc_try gfc_check_isnan (gfc_expr *); -gfc_try gfc_check_ishft (gfc_expr *, gfc_expr *); -gfc_try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_kill (gfc_expr *, gfc_expr *); -gfc_try gfc_check_kind (gfc_expr *); -gfc_try gfc_check_lbound (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_lcobound (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_len_lentrim (gfc_expr *, gfc_expr *); -gfc_try gfc_check_link (gfc_expr *, gfc_expr *); -gfc_try gfc_check_lge_lgt_lle_llt (gfc_expr *, gfc_expr *); -gfc_try gfc_check_loc (gfc_expr *); -gfc_try gfc_check_logical (gfc_expr *, gfc_expr *); -gfc_try gfc_check_min_max (gfc_actual_arglist *); -gfc_try gfc_check_min_max_integer (gfc_actual_arglist *); -gfc_try gfc_check_min_max_real (gfc_actual_arglist *); -gfc_try gfc_check_min_max_double (gfc_actual_arglist *); -gfc_try gfc_check_malloc (gfc_expr *); -gfc_try gfc_check_mask (gfc_expr *, gfc_expr *); -gfc_try gfc_check_matmul (gfc_expr *, gfc_expr *); -gfc_try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_minloc_maxloc (gfc_actual_arglist *); -gfc_try gfc_check_minval_maxval (gfc_actual_arglist *); -gfc_try gfc_check_nearest (gfc_expr *, gfc_expr *); -gfc_try gfc_check_new_line (gfc_expr *); -gfc_try gfc_check_norm2 (gfc_expr *, gfc_expr *); -gfc_try gfc_check_null (gfc_expr *); -gfc_try gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_parity (gfc_expr *, gfc_expr *); -gfc_try gfc_check_precision (gfc_expr *); -gfc_try gfc_check_present (gfc_expr *); -gfc_try gfc_check_product_sum (gfc_actual_arglist *); -gfc_try gfc_check_radix (gfc_expr *); -gfc_try gfc_check_rand (gfc_expr *); -gfc_try gfc_check_range (gfc_expr *); -gfc_try gfc_check_rank (gfc_expr *); -gfc_try gfc_check_real (gfc_expr *, gfc_expr *); -gfc_try gfc_check_rename (gfc_expr *, gfc_expr *); -gfc_try gfc_check_repeat (gfc_expr *, gfc_expr *); -gfc_try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_same_type_as (gfc_expr *, gfc_expr *); -gfc_try gfc_check_scale (gfc_expr *, gfc_expr *); -gfc_try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_second_sub (gfc_expr *); -gfc_try gfc_check_secnds (gfc_expr *); -gfc_try gfc_check_selected_char_kind (gfc_expr *); -gfc_try gfc_check_selected_int_kind (gfc_expr *); -gfc_try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_set_exponent (gfc_expr *, gfc_expr *); -gfc_try gfc_check_shape (gfc_expr *, gfc_expr *); -gfc_try gfc_check_shift (gfc_expr *, gfc_expr *); -gfc_try gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_sign (gfc_expr *, gfc_expr *); -gfc_try gfc_check_signal (gfc_expr *, gfc_expr *); -gfc_try gfc_check_sizeof (gfc_expr *); -gfc_try gfc_check_c_associated (gfc_expr *, gfc_expr *); -gfc_try gfc_check_c_f_pointer (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_c_f_procpointer (gfc_expr *, gfc_expr *); -gfc_try gfc_check_c_funloc (gfc_expr *); -gfc_try gfc_check_c_loc (gfc_expr *); -gfc_try gfc_check_c_sizeof (gfc_expr *); -gfc_try gfc_check_sngl (gfc_expr *); -gfc_try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_srand (gfc_expr *); -gfc_try gfc_check_stat (gfc_expr *, gfc_expr *); -gfc_try gfc_check_storage_size (gfc_expr *, gfc_expr *); -gfc_try gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_symlnk (gfc_expr *, gfc_expr *); -gfc_try gfc_check_transf_bit_intrins (gfc_actual_arglist *); -gfc_try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_transpose (gfc_expr *); -gfc_try gfc_check_trim (gfc_expr *); -gfc_try gfc_check_ttynam (gfc_expr *); -gfc_try gfc_check_ubound (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_ucobound (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_umask (gfc_expr *); -gfc_try gfc_check_unlink (gfc_expr *); -gfc_try gfc_check_unpack (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_x (gfc_expr *); +bool gfc_check_abs (gfc_expr *); +bool gfc_check_access_func (gfc_expr *, gfc_expr *); +bool gfc_check_achar (gfc_expr *, gfc_expr *); +bool gfc_check_all_any (gfc_expr *, gfc_expr *); +bool gfc_check_allocated (gfc_expr *); +bool gfc_check_associated (gfc_expr *, gfc_expr *); +bool gfc_check_atan_2 (gfc_expr *, gfc_expr *); +bool gfc_check_atan2 (gfc_expr *, gfc_expr *); +bool gfc_check_atomic_def (gfc_expr *, gfc_expr *); +bool gfc_check_atomic_ref (gfc_expr *, gfc_expr *); +bool gfc_check_besn (gfc_expr *, gfc_expr *); +bool gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *); +bool gfc_check_bitfcn (gfc_expr *, gfc_expr *); +bool gfc_check_char (gfc_expr *, gfc_expr *); +bool gfc_check_chdir (gfc_expr *); +bool gfc_check_chmod (gfc_expr *, gfc_expr *); +bool gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_complex (gfc_expr *, gfc_expr *); +bool gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_ctime (gfc_expr *); +bool gfc_check_datan2 (gfc_expr *, gfc_expr *); +bool gfc_check_dcmplx (gfc_expr *, gfc_expr *); +bool gfc_check_dble (gfc_expr *); +bool gfc_check_digits (gfc_expr *); +bool gfc_check_dot_product (gfc_expr *, gfc_expr *); +bool gfc_check_dprod (gfc_expr *, gfc_expr *); +bool gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_dtime_etime (gfc_expr *); +bool gfc_check_fgetputc (gfc_expr *, gfc_expr *); +bool gfc_check_fgetput (gfc_expr *); +bool gfc_check_float (gfc_expr *); +bool gfc_check_fstat (gfc_expr *, gfc_expr *); +bool gfc_check_ftell (gfc_expr *); +bool gfc_check_fn_c (gfc_expr *); +bool gfc_check_fn_d (gfc_expr *); +bool gfc_check_fn_r (gfc_expr *); +bool gfc_check_fn_rc (gfc_expr *); +bool gfc_check_fn_rc2008 (gfc_expr *); +bool gfc_check_fnum (gfc_expr *); +bool gfc_check_hostnm (gfc_expr *); +bool gfc_check_huge (gfc_expr *); +bool gfc_check_hypot (gfc_expr *, gfc_expr *); +bool gfc_check_i (gfc_expr *); +bool gfc_check_iand (gfc_expr *, gfc_expr *); +bool gfc_check_and (gfc_expr *, gfc_expr *); +bool gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_ichar_iachar (gfc_expr *, gfc_expr *); +bool gfc_check_idnint (gfc_expr *); +bool gfc_check_ieor (gfc_expr *, gfc_expr *); +bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_int (gfc_expr *, gfc_expr *); +bool gfc_check_intconv (gfc_expr *); +bool gfc_check_ior (gfc_expr *, gfc_expr *); +bool gfc_check_irand (gfc_expr *); +bool gfc_check_isatty (gfc_expr *); +bool gfc_check_isnan (gfc_expr *); +bool gfc_check_ishft (gfc_expr *, gfc_expr *); +bool gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_kill (gfc_expr *, gfc_expr *); +bool gfc_check_kind (gfc_expr *); +bool gfc_check_lbound (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_lcobound (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_len_lentrim (gfc_expr *, gfc_expr *); +bool gfc_check_link (gfc_expr *, gfc_expr *); +bool gfc_check_lge_lgt_lle_llt (gfc_expr *, gfc_expr *); +bool gfc_check_loc (gfc_expr *); +bool gfc_check_logical (gfc_expr *, gfc_expr *); +bool gfc_check_min_max (gfc_actual_arglist *); +bool gfc_check_min_max_integer (gfc_actual_arglist *); +bool gfc_check_min_max_real (gfc_actual_arglist *); +bool gfc_check_min_max_double (gfc_actual_arglist *); +bool gfc_check_malloc (gfc_expr *); +bool gfc_check_mask (gfc_expr *, gfc_expr *); +bool gfc_check_matmul (gfc_expr *, gfc_expr *); +bool gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_minloc_maxloc (gfc_actual_arglist *); +bool gfc_check_minval_maxval (gfc_actual_arglist *); +bool gfc_check_nearest (gfc_expr *, gfc_expr *); +bool gfc_check_new_line (gfc_expr *); +bool gfc_check_norm2 (gfc_expr *, gfc_expr *); +bool gfc_check_null (gfc_expr *); +bool gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_parity (gfc_expr *, gfc_expr *); +bool gfc_check_precision (gfc_expr *); +bool gfc_check_present (gfc_expr *); +bool gfc_check_product_sum (gfc_actual_arglist *); +bool gfc_check_radix (gfc_expr *); +bool gfc_check_rand (gfc_expr *); +bool gfc_check_range (gfc_expr *); +bool gfc_check_rank (gfc_expr *); +bool gfc_check_real (gfc_expr *, gfc_expr *); +bool gfc_check_rename (gfc_expr *, gfc_expr *); +bool gfc_check_repeat (gfc_expr *, gfc_expr *); +bool gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_same_type_as (gfc_expr *, gfc_expr *); +bool gfc_check_scale (gfc_expr *, gfc_expr *); +bool gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_second_sub (gfc_expr *); +bool gfc_check_secnds (gfc_expr *); +bool gfc_check_selected_char_kind (gfc_expr *); +bool gfc_check_selected_int_kind (gfc_expr *); +bool gfc_check_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_set_exponent (gfc_expr *, gfc_expr *); +bool gfc_check_shape (gfc_expr *, gfc_expr *); +bool gfc_check_shift (gfc_expr *, gfc_expr *); +bool gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_sign (gfc_expr *, gfc_expr *); +bool gfc_check_signal (gfc_expr *, gfc_expr *); +bool gfc_check_sizeof (gfc_expr *); +bool gfc_check_c_associated (gfc_expr *, gfc_expr *); +bool gfc_check_c_f_pointer (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_c_f_procpointer (gfc_expr *, gfc_expr *); +bool gfc_check_c_funloc (gfc_expr *); +bool gfc_check_c_loc (gfc_expr *); +bool gfc_check_c_sizeof (gfc_expr *); +bool gfc_check_sngl (gfc_expr *); +bool gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_srand (gfc_expr *); +bool gfc_check_stat (gfc_expr *, gfc_expr *); +bool gfc_check_storage_size (gfc_expr *, gfc_expr *); +bool gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_symlnk (gfc_expr *, gfc_expr *); +bool gfc_check_transf_bit_intrins (gfc_actual_arglist *); +bool gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_transpose (gfc_expr *); +bool gfc_check_trim (gfc_expr *); +bool gfc_check_ttynam (gfc_expr *); +bool gfc_check_ubound (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_ucobound (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_umask (gfc_expr *); +bool gfc_check_unlink (gfc_expr *); +bool gfc_check_unpack (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_x (gfc_expr *); /* Intrinsic subroutines. */ -gfc_try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_chdir_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_cpu_time (gfc_expr *); -gfc_try gfc_check_ctime_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_exit (gfc_expr *); -gfc_try gfc_check_fdate_sub (gfc_expr *); -gfc_try gfc_check_flush (gfc_expr *); -gfc_try gfc_check_free (gfc_expr *); -gfc_try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_gerror (gfc_expr *); -gfc_try gfc_check_getarg (gfc_expr *, gfc_expr *); -gfc_try gfc_check_getlog (gfc_expr *); -gfc_try gfc_check_move_alloc (gfc_expr *, gfc_expr *); -gfc_try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, +bool gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_chdir_sub (gfc_expr *, gfc_expr *); +bool gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_cpu_time (gfc_expr *); +bool gfc_check_ctime_sub (gfc_expr *, gfc_expr *); +bool gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_exit (gfc_expr *); +bool gfc_check_fdate_sub (gfc_expr *); +bool gfc_check_flush (gfc_expr *); +bool gfc_check_free (gfc_expr *); +bool gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_gerror (gfc_expr *); +bool gfc_check_getarg (gfc_expr *, gfc_expr *); +bool gfc_check_getlog (gfc_expr *); +bool gfc_check_move_alloc (gfc_expr *, gfc_expr *); +bool gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_random_number (gfc_expr *); -gfc_try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_fgetput_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_ftell_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_image_index (gfc_expr *, gfc_expr *); -gfc_try gfc_check_itime_idate (gfc_expr *); -gfc_try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *); -gfc_try gfc_check_perror (gfc_expr *); -gfc_try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_signal_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_sleep_sub (gfc_expr *); -gfc_try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *); -gfc_try gfc_check_system_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_this_image (gfc_expr *, gfc_expr *); -gfc_try gfc_check_ttynam_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_umask_sub (gfc_expr *, gfc_expr *); -gfc_try gfc_check_unlink_sub (gfc_expr *, gfc_expr *); +bool gfc_check_random_number (gfc_expr *); +bool gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *); +bool gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_fgetput_sub (gfc_expr *, gfc_expr *); +bool gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_ftell_sub (gfc_expr *, gfc_expr *); +bool gfc_check_getcwd_sub (gfc_expr *, gfc_expr *); +bool gfc_check_hostnm_sub (gfc_expr *, gfc_expr *); +bool gfc_check_image_index (gfc_expr *, gfc_expr *); +bool gfc_check_itime_idate (gfc_expr *); +bool gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *); +bool gfc_check_perror (gfc_expr *); +bool gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_signal_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_sleep_sub (gfc_expr *); +bool gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_system_sub (gfc_expr *, gfc_expr *); +bool gfc_check_this_image (gfc_expr *, gfc_expr *); +bool gfc_check_ttynam_sub (gfc_expr *, gfc_expr *); +bool gfc_check_umask_sub (gfc_expr *, gfc_expr *); +bool gfc_check_unlink_sub (gfc_expr *, gfc_expr *); /* Simplification functions. */ diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 748a4f2..c5120dd 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -100,7 +100,7 @@ static const io_tag static gfc_dt *current_dt; -#define RESOLVE_TAG(x, y) if (resolve_tag(x, y) == FAILURE) return FAILURE; +#define RESOLVE_TAG(x, y) if (!resolve_tag (x, y)) return false; /**************** Fortran 95 FORMAT parser *****************/ @@ -452,15 +452,15 @@ format_lex (void) c = next_char_not_space (&error); if (c == 'P') { - if (gfc_notify_std (GFC_STD_F2003, "DP format " - "specifier not allowed at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "DP format " + "specifier not allowed at %C")) return FMT_ERROR; token = FMT_DP; } else if (c == 'C') { - if (gfc_notify_std (GFC_STD_F2003, "DC format " - "specifier not allowed at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "DC format " + "specifier not allowed at %C")) return FMT_ERROR; token = FMT_DC; } @@ -545,7 +545,7 @@ token_to_string (format_token t) by itself, and we are checking it for validity. The dual origin means that the warning message is a little less than great. */ -static gfc_try +static bool check_format (bool is_input) { const char *posint_required = _("Positive width required"); @@ -559,13 +559,13 @@ check_format (bool is_input) format_token t, u; int level; int repeat; - gfc_try rv; + bool rv; use_last_char = 0; saved_token = FMT_NONE; level = 0; repeat = 0; - rv = SUCCESS; + rv = true; format_string_pos = 0; t = format_lex (); @@ -648,10 +648,9 @@ format_item_1: /* X requires a prior number if we're being pedantic. */ if (mode != MODE_FORMAT) format_locus.nextc += format_string_pos; - if (gfc_notify_std (GFC_STD_GNU, "X descriptor " - "requires leading space count at %L", &format_locus) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "X descriptor requires leading " + "space count at %L", &format_locus)) + return false; goto between_desc; case FMT_SIGN: @@ -678,9 +677,8 @@ format_item_1: if (t == FMT_ERROR) goto fail; - if (gfc_notify_std (GFC_STD_GNU, "$ descriptor at %L", - &format_locus) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "$ descriptor at %L", &format_locus)) + return false; if (t != FMT_RPAREN || level > 0) { gfc_warning ("$ should be the last specifier in format at %L", @@ -825,9 +823,9 @@ data_desc: error = zero_width; goto syntax; } - if (gfc_notify_std (GFC_STD_F2008, "'G0' in " - "format at %L", &format_locus) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2008, "'G0' in format at %L", + &format_locus)) + return false; u = format_lex (); if (u != FMT_PERIOD) { @@ -1058,9 +1056,8 @@ between_desc: default: if (mode != MODE_FORMAT) format_locus.nextc += format_string_pos - 1; - if (gfc_notify_std (GFC_STD_GNU, "Missing comma at %L", - &format_locus) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "Missing comma at %L", &format_locus)) + return false; /* If we do not actually return a failure, we need to unwind this before the next round. */ if (mode != MODE_FORMAT) @@ -1121,9 +1118,8 @@ extension_optional_comma: default: if (mode != MODE_FORMAT) format_locus.nextc += format_string_pos; - if (gfc_notify_std (GFC_STD_GNU, "Missing comma at %L", - &format_locus) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "Missing comma at %L", &format_locus)) + return false; /* If we do not actually return a failure, we need to unwind this before the next round. */ if (mode != MODE_FORMAT) @@ -1142,7 +1138,7 @@ syntax: else gfc_error ("%s in format string at %L", error, &format_locus); fail: - rv = FAILURE; + rv = false; finished: return rv; @@ -1152,13 +1148,13 @@ finished: /* Given an expression node that is a constant string, see if it looks like a format string. */ -static gfc_try +static bool check_format_string (gfc_expr *e, bool is_input) { - gfc_try rv; + bool rv; int i; if (!e || e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT) - return SUCCESS; + return true; mode = MODE_STRING; format_string = e->value.character.string; @@ -1172,7 +1168,7 @@ check_format_string (gfc_expr *e, bool is_input) string, like '(A10,I3)F5' start at the end and move back to the last character processed, spaces are OK */ - if (rv == SUCCESS && e->value.character.length > format_string_pos) + if (rv && e->value.character.length > format_string_pos) for (i=e->value.character.length-1;i>format_string_pos-1;i--) if (e->value.character.string[i] != ' ') { @@ -1215,7 +1211,7 @@ gfc_match_format (void) start = gfc_current_locus; - if (check_format (false) == FAILURE) + if (!check_format (false)) return MATCH_ERROR; if (gfc_match_eos () != MATCH_YES) @@ -1366,7 +1362,7 @@ match_ltag (const io_tag *tag, gfc_st_label ** label) return MATCH_ERROR; } - if (gfc_reference_st_label (*label, ST_LABEL_TARGET) == FAILURE) + if (!gfc_reference_st_label (*label, ST_LABEL_TARGET)) return MATCH_ERROR; return m; @@ -1375,7 +1371,7 @@ match_ltag (const io_tag *tag, gfc_st_label ** label) /* Resolution of the FORMAT tag, to be called from resolve_tag. */ -static gfc_try +static bool resolve_tag_format (const gfc_expr *e) { if (e->expr_type == EXPR_CONSTANT @@ -1384,7 +1380,7 @@ resolve_tag_format (const gfc_expr *e) { gfc_error ("Constant expression in FORMAT tag at %L must be " "of type default CHARACTER", &e->where); - return FAILURE; + return false; } /* If e's rank is zero and e is not an element of an array, it should be @@ -1402,75 +1398,74 @@ resolve_tag_format (const gfc_expr *e) { gfc_error ("FORMAT tag at %L must be of type default-kind CHARACTER " "or of INTEGER", &e->where); - return FAILURE; + return false; } else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE) { - if (gfc_notify_std (GFC_STD_F95_DEL, "ASSIGNED " - "variable in FORMAT tag at %L", &e->where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F95_DEL, "ASSIGNED variable in " + "FORMAT tag at %L", &e->where)) + return false; if (e->symtree->n.sym->attr.assign != 1) { gfc_error ("Variable '%s' at %L has not been assigned a " "format label", e->symtree->n.sym->name, &e->where); - return FAILURE; + return false; } } else if (e->ts.type == BT_INTEGER) { gfc_error ("Scalar '%s' in FORMAT tag at %L is not an ASSIGNED " "variable", gfc_basic_typename (e->ts.type), &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* If rank is nonzero and type is not character, we allow it under GFC_STD_LEGACY. It may be assigned an Hollerith constant. */ if (e->ts.type != BT_CHARACTER) { - if (gfc_notify_std (GFC_STD_LEGACY, "Non-character " - "in FORMAT tag at %L", &e->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, "Non-character in FORMAT tag " + "at %L", &e->where)) + return false; if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE) { gfc_error ("Non-character assumed shape array element in FORMAT" " tag at %L", &e->where); - return FAILURE; + return false; } if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE) { gfc_error ("Non-character assumed size array element in FORMAT" " tag at %L", &e->where); - return FAILURE; + return false; } if (e->rank == 0 && e->symtree->n.sym->attr.pointer) { gfc_error ("Non-character pointer array element in FORMAT tag at %L", &e->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } /* Do expression resolution and type-checking on an expression tag. */ -static gfc_try +static bool resolve_tag (const io_tag *tag, gfc_expr *e) { if (e == NULL) - return SUCCESS; + return true; - if (gfc_resolve_expr (e) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (e)) + return false; if (tag == &tag_format) return resolve_tag_format (e); @@ -1479,51 +1474,48 @@ resolve_tag (const io_tag *tag, gfc_expr *e) { gfc_error ("%s tag at %L must be of type %s", tag->name, &e->where, gfc_basic_typename (tag->type)); - return FAILURE; + return false; } if (e->ts.type == BT_CHARACTER && e->ts.kind != gfc_default_character_kind) { gfc_error ("%s tag at %L must be a character string of default kind", tag->name, &e->where); - return FAILURE; + return false; } if (e->rank != 0) { gfc_error ("%s tag at %L must be scalar", tag->name, &e->where); - return FAILURE; + return false; } if (tag == &tag_iomsg) { - if (gfc_notify_std (GFC_STD_F2003, "IOMSG tag at %L", - &e->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2003, "IOMSG tag at %L", &e->where)) + return false; } if ((tag == &tag_iostat || tag == &tag_size || tag == &tag_iolength) && e->ts.kind != gfc_default_integer_kind) { - if (gfc_notify_std (GFC_STD_F2003, "Fortran 95 requires default " - "INTEGER in %s tag at %L", tag->name, &e->where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2003, "Fortran 95 requires default " + "INTEGER in %s tag at %L", tag->name, &e->where)) + return false; } if (tag == &tag_exist && e->ts.kind != gfc_default_logical_kind) { - if (gfc_notify_std (GFC_STD_F2008, "Nondefault LOGICAL " - "in %s tag at %L", tag->name, &e->where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2008, "Nondefault LOGICAL " + "in %s tag at %L", tag->name, &e->where)) + return false; } if (tag == &tag_newunit) { - if (gfc_notify_std (GFC_STD_F2008, "NEWUNIT specifier" - " at %L", &e->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2008, "NEWUNIT specifier at %L", + &e->where)) + return false; } /* NEWUNIT, IOSTAT, SIZE and IOMSG are variable definition contexts. */ @@ -1533,18 +1525,17 @@ resolve_tag (const io_tag *tag, gfc_expr *e) char context[64]; sprintf (context, _("%s tag"), tag->name); - if (gfc_check_vardef_context (e, false, false, false, context) == FAILURE) - return FAILURE; + if (!gfc_check_vardef_context (e, false, false, false, context)) + return false; } if (tag == &tag_convert) { - if (gfc_notify_std (GFC_STD_GNU, "CONVERT tag at %L", - &e->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "CONVERT tag at %L", &e->where)) + return false; } - return SUCCESS; + return true; } @@ -1657,7 +1648,7 @@ gfc_free_open (gfc_open *open) /* Resolve everything in a gfc_open structure. */ -gfc_try +bool gfc_resolve_open (gfc_open *open) { @@ -1682,10 +1673,10 @@ gfc_resolve_open (gfc_open *open) RESOLVE_TAG (&tag_convert, open->convert); RESOLVE_TAG (&tag_newunit, open->newunit); - if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (open->err, ST_LABEL_TARGET)) + return false; - return SUCCESS; + return true; } @@ -1895,8 +1886,8 @@ gfc_match_open (void) /* Checks on the ASYNCHRONOUS specifier. */ if (open->asynchronous) { - if (gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS= at %C " + "not allowed in Fortran 95")) goto cleanup; if (open->asynchronous->expr_type == EXPR_CONSTANT) @@ -1913,8 +1904,8 @@ gfc_match_open (void) /* Checks on the BLANK specifier. */ if (open->blank) { - if (gfc_notify_std (GFC_STD_F2003, "BLANK= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "BLANK= at %C " + "not allowed in Fortran 95")) goto cleanup; if (open->blank->expr_type == EXPR_CONSTANT) @@ -1931,8 +1922,8 @@ gfc_match_open (void) /* Checks on the DECIMAL specifier. */ if (open->decimal) { - if (gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C " + "not allowed in Fortran 95")) goto cleanup; if (open->decimal->expr_type == EXPR_CONSTANT) @@ -1963,8 +1954,8 @@ gfc_match_open (void) /* Checks on the ENCODING specifier. */ if (open->encoding) { - if (gfc_notify_std (GFC_STD_F2003, "ENCODING= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "ENCODING= at %C " + "not allowed in Fortran 95")) goto cleanup; if (open->encoding->expr_type == EXPR_CONSTANT) @@ -2014,8 +2005,8 @@ gfc_match_open (void) /* Checks on the ROUND specifier. */ if (open->round) { - if (gfc_notify_std (GFC_STD_F2003, "ROUND= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "ROUND= at %C " + "not allowed in Fortran 95")) goto cleanup; if (open->round->expr_type == EXPR_CONSTANT) @@ -2034,8 +2025,8 @@ gfc_match_open (void) /* Checks on the SIGN specifier. */ if (open->sign) { - if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "SIGN= at %C " + "not allowed in Fortran 95")) goto cleanup; if (open->sign->expr_type == EXPR_CONSTANT) @@ -2282,7 +2273,7 @@ cleanup: /* Resolve everything in a gfc_close structure. */ -gfc_try +bool gfc_resolve_close (gfc_close *close) { RESOLVE_TAG (&tag_unit, close->unit); @@ -2290,8 +2281,8 @@ gfc_resolve_close (gfc_close *close) RESOLVE_TAG (&tag_iostat, close->iostat); RESOLVE_TAG (&tag_status, close->status); - if (gfc_reference_st_label (close->err, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (close->err, ST_LABEL_TARGET)) + return false; if (close->unit == NULL) { @@ -2308,7 +2299,7 @@ gfc_resolve_close (gfc_close *close) loc = close->err->where; gfc_error ("CLOSE statement at %L requires a UNIT number", &loc); - return FAILURE; + return false; } if (close->unit->expr_type == EXPR_CONSTANT @@ -2319,7 +2310,7 @@ gfc_resolve_close (gfc_close *close) &close->unit->where); } - return SUCCESS; + return true; } @@ -2435,14 +2426,14 @@ cleanup: } -gfc_try +bool gfc_resolve_filepos (gfc_filepos *fp) { RESOLVE_TAG (&tag_unit, fp->unit); RESOLVE_TAG (&tag_iostat, fp->iostat); RESOLVE_TAG (&tag_iomsg, fp->iomsg); - if (gfc_reference_st_label (fp->err, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (fp->err, ST_LABEL_TARGET)) + return false; if (fp->unit->expr_type == EXPR_CONSTANT && fp->unit->ts.type == BT_INTEGER @@ -2452,7 +2443,7 @@ gfc_resolve_filepos (gfc_filepos *fp) &fp->unit->where); } - return SUCCESS; + return true; } @@ -2480,8 +2471,7 @@ gfc_match_rewind (void) match gfc_match_flush (void) { - if (gfc_notify_std (GFC_STD_F2003, "FLUSH statement at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "FLUSH statement at %C")) return MATCH_ERROR; return match_filepos (ST_FLUSH, EXEC_FLUSH); @@ -2583,7 +2573,7 @@ match_dt_format (gfc_dt *dt) goto conflict; } - if (gfc_reference_st_label (label, ST_LABEL_FORMAT) == FAILURE) + if (!gfc_reference_st_label (label, ST_LABEL_FORMAT)) return MATCH_ERROR; dt->format_label = label; @@ -2785,7 +2775,7 @@ gfc_free_dt (gfc_dt *dt) /* Resolve everything in a gfc_dt structure. */ -gfc_try +bool gfc_resolve_dt (gfc_dt *dt, locus *loc) { gfc_expr *e; @@ -2815,10 +2805,10 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc) if (e == NULL) { gfc_error ("UNIT not specified at %L", loc); - return FAILURE; + return false; } - if (gfc_resolve_expr (e) == SUCCESS + if (gfc_resolve_expr (e) && (e->ts.type != BT_INTEGER && (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE))) { @@ -2828,7 +2818,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc) { gfc_error ("UNIT specification at %L must be an INTEGER expression " "or a CHARACTER variable", &e->where); - return FAILURE; + return false; } else { @@ -2850,7 +2840,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc) { gfc_error ("Invalid form of WRITE statement at %L, UNIT required", &dt->extra_comma->where); - return FAILURE; + return false; } } } @@ -2860,21 +2850,21 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc) if (gfc_has_vector_index (e)) { gfc_error ("Internal unit with vector subscript at %L", &e->where); - return FAILURE; + return false; } /* If we are writing, make sure the internal unit can be changed. */ gcc_assert (k != M_PRINT); if (k == M_WRITE - && gfc_check_vardef_context (e, false, false, false, - _("internal unit in WRITE")) == FAILURE) - return FAILURE; + && !gfc_check_vardef_context (e, false, false, false, + _("internal unit in WRITE"))) + return false; } if (e->rank && e->ts.type != BT_CHARACTER) { gfc_error ("External IO UNIT cannot be an array at %L", &e->where); - return FAILURE; + return false; } if (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_INTEGER @@ -2882,7 +2872,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc) { gfc_error ("UNIT number in statement at %L must be non-negative", &e->where); - return FAILURE; + return false; } /* If we are reading and have a namelist, check that all namelist symbols @@ -2893,61 +2883,61 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc) for (n = dt->namelist->namelist; n; n = n->next) { gfc_expr* e; - gfc_try t; + bool t; e = gfc_get_variable_expr (gfc_find_sym_in_symtree (n->sym)); t = gfc_check_vardef_context (e, false, false, false, NULL); gfc_free_expr (e); - if (t == FAILURE) + if (!t) { gfc_error ("NAMELIST '%s' in READ statement at %L contains" " the symbol '%s' which may not appear in a" " variable definition context", dt->namelist->name, loc, n->sym->name); - return FAILURE; + return false; } } } if (dt->extra_comma - && gfc_notify_std (GFC_STD_GNU, "Comma before i/o " - "item list at %L", &dt->extra_comma->where) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_GNU, "Comma before i/o item list at %L", + &dt->extra_comma->where)) + return false; if (dt->err) { - if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (dt->err, ST_LABEL_TARGET)) + return false; if (dt->err->defined == ST_LABEL_UNKNOWN) { gfc_error ("ERR tag label %d at %L not defined", dt->err->value, &dt->err_where); - return FAILURE; + return false; } } if (dt->end) { - if (gfc_reference_st_label (dt->end, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (dt->end, ST_LABEL_TARGET)) + return false; if (dt->end->defined == ST_LABEL_UNKNOWN) { gfc_error ("END tag label %d at %L not defined", dt->end->value, &dt->end_where); - return FAILURE; + return false; } } if (dt->eor) { - if (gfc_reference_st_label (dt->eor, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (dt->eor, ST_LABEL_TARGET)) + return false; if (dt->eor->defined == ST_LABEL_UNKNOWN) { gfc_error ("EOR tag label %d at %L not defined", dt->eor->value, &dt->eor_where); - return FAILURE; + return false; } } @@ -2957,10 +2947,10 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc) { gfc_error ("FORMAT label %d at %L not defined", dt->format_label->value, &dt->format_label->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -3257,9 +3247,8 @@ if (condition) \ if (dt->namelist != NULL) { - if (gfc_notify_std (GFC_STD_F2003, "Internal file " - "at %L with namelist", &expr->where) - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "Internal file at %L with " + "namelist", &expr->where)) m = MATCH_ERROR; } @@ -3313,7 +3302,7 @@ if (condition) \ { static const char * asynchronous[] = { "YES", "NO", NULL }; - if (gfc_reduce_init_expr (dt->asynchronous) != SUCCESS) + if (!gfc_reduce_init_expr (dt->asynchronous)) { gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization " "expression", &dt->asynchronous->where); @@ -3341,8 +3330,8 @@ if (condition) \ if (dt->decimal) { - if (gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C " + "not allowed in Fortran 95")) return MATCH_ERROR; if (dt->decimal->expr_type == EXPR_CONSTANT) @@ -3362,8 +3351,8 @@ if (condition) \ if (dt->blank) { - if (gfc_notify_std (GFC_STD_F2003, "BLANK= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "BLANK= at %C " + "not allowed in Fortran 95")) return MATCH_ERROR; if (dt->blank->expr_type == EXPR_CONSTANT) @@ -3383,8 +3372,8 @@ if (condition) \ if (dt->pad) { - if (gfc_notify_std (GFC_STD_F2003, "PAD= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "PAD= at %C " + "not allowed in Fortran 95")) return MATCH_ERROR; if (dt->pad->expr_type == EXPR_CONSTANT) @@ -3404,8 +3393,8 @@ if (condition) \ if (dt->round) { - if (gfc_notify_std (GFC_STD_F2003, "ROUND= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "ROUND= at %C " + "not allowed in Fortran 95")) return MATCH_ERROR; if (dt->round->expr_type == EXPR_CONSTANT) @@ -3425,7 +3414,7 @@ if (condition) \ { /* When implemented, change the following to use gfc_notify_std F2003. if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C " - "not allowed in Fortran 95") == FAILURE) + "not allowed in Fortran 95") == false) return MATCH_ERROR; */ if (dt->sign->expr_type == EXPR_CONSTANT) { @@ -3449,8 +3438,8 @@ if (condition) \ if (dt->delim) { - if (gfc_notify_std (GFC_STD_F2003, "DELIM= at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "DELIM= at %C " + "not allowed in Fortran 95")) return MATCH_ERROR; if (dt->delim->expr_type == EXPR_CONSTANT) @@ -3557,8 +3546,8 @@ if (condition) \ } expr = dt->format_expr; - if (gfc_simplify_expr (expr, 0) == FAILURE - || check_format_string (expr, k == M_READ) == FAILURE) + if (!gfc_simplify_expr (expr, 0) + || !check_format_string (expr, k == M_READ)) return MATCH_ERROR; return m; @@ -3598,8 +3587,8 @@ match_io (io_kind k) gfc_find_symbol (name, NULL, 1, &sym); if (sym && sym->attr.flavor == FL_NAMELIST) { - if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at " - "%C is an extension") == FAILURE) + if (!gfc_notify_std (GFC_STD_GNU, "PRINT namelist at " + "%C is an extension")) { m = MATCH_ERROR; goto cleanup; @@ -4048,7 +4037,7 @@ cleanup: /* Resolve everything in a gfc_inquire structure. */ -gfc_try +bool gfc_resolve_inquire (gfc_inquire *inquire) { RESOLVE_TAG (&tag_unit, inquire->unit); @@ -4064,8 +4053,8 @@ gfc_resolve_inquire (gfc_inquire *inquire) char context[64]; \ sprintf (context, _("%s tag with INQUIRE"), (tag)->name); \ if (gfc_check_vardef_context ((expr), false, false, false, \ - context) == FAILURE) \ - return FAILURE; \ + context) == false) \ + return false; \ } INQUIRE_RESOLVE_TAG (&tag_iomsg, inquire->iomsg); INQUIRE_RESOLVE_TAG (&tag_iostat, inquire->iostat); @@ -4104,10 +4093,10 @@ gfc_resolve_inquire (gfc_inquire *inquire) INQUIRE_RESOLVE_TAG (&tag_s_iqstream, inquire->iqstream); #undef INQUIRE_RESOLVE_TAG - if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (inquire->err, ST_LABEL_TARGET)) + return false; - return SUCCESS; + return true; } @@ -4125,7 +4114,7 @@ gfc_free_wait (gfc_wait *wait) } -gfc_try +bool gfc_resolve_wait (gfc_wait *wait) { RESOLVE_TAG (&tag_unit, wait->unit); @@ -4133,13 +4122,13 @@ gfc_resolve_wait (gfc_wait *wait) RESOLVE_TAG (&tag_iostat, wait->iostat); RESOLVE_TAG (&tag_id, wait->id); - if (gfc_reference_st_label (wait->err, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (wait->err, ST_LABEL_TARGET)) + return false; - if (gfc_reference_st_label (wait->end, ST_LABEL_TARGET) == FAILURE) - return FAILURE; + if (!gfc_reference_st_label (wait->end, ST_LABEL_TARGET)) + return false; - return SUCCESS; + return true; } /* Match an element of a WAIT statement. */ @@ -4202,8 +4191,8 @@ gfc_match_wait (void) goto syntax; } - if (gfc_notify_std (GFC_STD_F2003, "WAIT at %C " - "not allowed in Fortran 95") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "WAIT at %C " + "not allowed in Fortran 95")) goto cleanup; if (gfc_pure (NULL)) diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index be8740c..a1529da 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -505,8 +505,8 @@ gfc_match_label (void) return MATCH_ERROR; } - if (gfc_add_flavor (&gfc_new_block->attr, FL_LABEL, - gfc_new_block->name, NULL) == FAILURE) + if (!gfc_add_flavor (&gfc_new_block->attr, FL_LABEL, + gfc_new_block->name, NULL)) return MATCH_ERROR; return MATCH_YES; @@ -531,7 +531,7 @@ gfc_match_name (char *buffer) c = gfc_next_ascii_char (); if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore))) { - if (gfc_error_flag_test() == 0 && c != '(') + if (gfc_error_flag_test () == 0 && c != '(') gfc_error ("Invalid character in name at %C"); gfc_current_locus = old_loc; return MATCH_NO; @@ -1268,7 +1268,7 @@ gfc_match_program (void) if (m == MATCH_ERROR) return m; - if (gfc_add_flavor (&sym->attr, FL_PROGRAM, sym->name, NULL) == FAILURE) + if (!gfc_add_flavor (&sym->attr, FL_PROGRAM, sym->name, NULL)) return MATCH_ERROR; gfc_new_block = sym; @@ -1383,16 +1383,15 @@ match_arithmetic_if (void) if (m != MATCH_YES) return m; - if (gfc_reference_st_label (l1, ST_LABEL_TARGET) == FAILURE - || gfc_reference_st_label (l2, ST_LABEL_TARGET) == FAILURE - || gfc_reference_st_label (l3, ST_LABEL_TARGET) == FAILURE) + if (!gfc_reference_st_label (l1, ST_LABEL_TARGET) + || !gfc_reference_st_label (l2, ST_LABEL_TARGET) + || !gfc_reference_st_label (l3, ST_LABEL_TARGET)) { gfc_free_expr (expr); return MATCH_ERROR; } - if (gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF " - "statement at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF statement at %C")) return MATCH_ERROR; new_st.op = EXEC_ARITHMETIC_IF; @@ -1464,16 +1463,15 @@ gfc_match_if (gfc_statement *if_type) return MATCH_ERROR; } - if (gfc_reference_st_label (l1, ST_LABEL_TARGET) == FAILURE - || gfc_reference_st_label (l2, ST_LABEL_TARGET) == FAILURE - || gfc_reference_st_label (l3, ST_LABEL_TARGET) == FAILURE) + if (!gfc_reference_st_label (l1, ST_LABEL_TARGET) + || !gfc_reference_st_label (l2, ST_LABEL_TARGET) + || !gfc_reference_st_label (l3, ST_LABEL_TARGET)) { gfc_free_expr (expr); return MATCH_ERROR; } - if (gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF " - "statement at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF statement at %C")) return MATCH_ERROR; new_st.op = EXEC_ARITHMETIC_IF; @@ -1539,7 +1537,7 @@ gfc_match_if (gfc_statement *if_type) restore between tries. */ #define match(string, subr, statement) \ - if (gfc_match(string) == MATCH_YES) { m = subr(); goto got_match; } + if (gfc_match (string) == MATCH_YES) { m = subr(); goto got_match; } gfc_clear_error (); @@ -1746,7 +1744,7 @@ gfc_match_critical (void) return MATCH_ERROR; } - if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS) + if (gfc_find_state (COMP_DO_CONCURRENT)) { gfc_error ("Image control statement CRITICAL at %C in DO CONCURRENT " "block"); @@ -1756,8 +1754,7 @@ gfc_match_critical (void) if (gfc_implicit_pure (NULL)) gfc_current_ns->proc_name->attr.implicit_pure = 0; - if (gfc_notify_std (GFC_STD_F2008, "CRITICAL statement at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "CRITICAL statement at %C")) return MATCH_ERROR; if (gfc_option.coarray == GFC_FCOARRAY_NONE) @@ -1766,7 +1763,7 @@ gfc_match_critical (void) return MATCH_ERROR; } - if (gfc_find_state (COMP_CRITICAL) == SUCCESS) + if (gfc_find_state (COMP_CRITICAL)) { gfc_error ("Nested CRITICAL block at %C"); return MATCH_ERROR; @@ -1775,7 +1772,7 @@ gfc_match_critical (void) new_st.op = EXEC_CRITICAL; if (label != NULL - && gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE) + && !gfc_reference_st_label (label, ST_LABEL_TARGET)) return MATCH_ERROR; return MATCH_YES; @@ -2380,8 +2377,7 @@ gfc_match_do (void) gfc_forall_iterator *head; gfc_expr *mask; - if (gfc_notify_std (GFC_STD_F2008, "DO CONCURRENT " - "construct at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "DO CONCURRENT construct at %C")) return MATCH_ERROR; @@ -2398,7 +2394,7 @@ gfc_match_do (void) goto concurr_cleanup; if (label != NULL - && gfc_reference_st_label (label, ST_LABEL_DO_TARGET) == FAILURE) + && !gfc_reference_st_label (label, ST_LABEL_DO_TARGET)) goto concurr_cleanup; new_st.label1 = label; @@ -2452,7 +2448,7 @@ concurr_cleanup: done: if (label != NULL - && gfc_reference_st_label (label, ST_LABEL_DO_TARGET) == FAILURE) + && !gfc_reference_st_label (label, ST_LABEL_DO_TARGET)) goto cleanup; new_st.label1 = label; @@ -2579,8 +2575,8 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) return MATCH_ERROR; } gcc_assert (op == EXEC_EXIT); - if (gfc_notify_std (GFC_STD_F2008, "EXIT statement with no" - " do-construct-name at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "EXIT statement with no" + " do-construct-name at %C")) return MATCH_ERROR; break; @@ -2686,12 +2682,12 @@ gfc_match_stopcode (gfc_statement st) if (gfc_implicit_pure (NULL)) gfc_current_ns->proc_name->attr.implicit_pure = 0; - if (st == ST_STOP && gfc_find_state (COMP_CRITICAL) == SUCCESS) + if (st == ST_STOP && gfc_find_state (COMP_CRITICAL)) { gfc_error ("Image control statement STOP at %C in CRITICAL block"); goto cleanup; } - if (st == ST_STOP && gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS) + if (st == ST_STOP && gfc_find_state (COMP_DO_CONCURRENT)) { gfc_error ("Image control statement STOP at %C in DO CONCURRENT block"); goto cleanup; @@ -2770,9 +2766,7 @@ gfc_match_pause (void) m = gfc_match_stopcode (ST_PAUSE); if (m == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F95_DEL, "PAUSE statement" - " at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F95_DEL, "PAUSE statement at %C")) m = MATCH_ERROR; } return m; @@ -2793,8 +2787,7 @@ gfc_match_stop (void) match gfc_match_error_stop (void) { - if (gfc_notify_std (GFC_STD_F2008, "ERROR STOP statement at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "ERROR STOP statement at %C")) return MATCH_ERROR; return gfc_match_stopcode (ST_ERROR_STOP); @@ -2833,14 +2826,14 @@ lock_unlock_statement (gfc_statement st) return MATCH_ERROR; } - if (gfc_find_state (COMP_CRITICAL) == SUCCESS) + if (gfc_find_state (COMP_CRITICAL)) { gfc_error ("Image control statement %s at %C in CRITICAL block", st == ST_LOCK ? "LOCK" : "UNLOCK"); return MATCH_ERROR; } - if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS) + if (gfc_find_state (COMP_DO_CONCURRENT)) { gfc_error ("Image control statement %s at %C in DO CONCURRENT block", st == ST_LOCK ? "LOCK" : "UNLOCK"); @@ -2979,8 +2972,7 @@ cleanup: match gfc_match_lock (void) { - if (gfc_notify_std (GFC_STD_F2008, "LOCK statement at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "LOCK statement at %C")) return MATCH_ERROR; return lock_unlock_statement (ST_LOCK); @@ -2990,8 +2982,7 @@ gfc_match_lock (void) match gfc_match_unlock (void) { - if (gfc_notify_std (GFC_STD_F2008, "UNLOCK statement at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "UNLOCK statement at %C")) return MATCH_ERROR; return lock_unlock_statement (ST_UNLOCK); @@ -3023,8 +3014,7 @@ sync_statement (gfc_statement st) if (gfc_implicit_pure (NULL)) gfc_current_ns->proc_name->attr.implicit_pure = 0; - if (gfc_notify_std (GFC_STD_F2008, "SYNC statement at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "SYNC statement at %C")) return MATCH_ERROR; if (gfc_option.coarray == GFC_FCOARRAY_NONE) @@ -3033,13 +3023,13 @@ sync_statement (gfc_statement st) return MATCH_ERROR; } - if (gfc_find_state (COMP_CRITICAL) == SUCCESS) + if (gfc_find_state (COMP_CRITICAL)) { gfc_error ("Image control statement SYNC at %C in CRITICAL block"); return MATCH_ERROR; } - if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS) + if (gfc_find_state (COMP_DO_CONCURRENT)) { gfc_error ("Image control statement SYNC at %C in DO CONCURRENT block"); return MATCH_ERROR; @@ -3217,13 +3207,11 @@ gfc_match_assign (void) if (gfc_match (" %l", &label) == MATCH_YES) { - if (gfc_reference_st_label (label, ST_LABEL_UNKNOWN) == FAILURE) + if (!gfc_reference_st_label (label, ST_LABEL_UNKNOWN)) return MATCH_ERROR; if (gfc_match (" to %v%t", &expr) == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F95_DEL, "ASSIGN " - "statement at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F95_DEL, "ASSIGN statement at %C")) return MATCH_ERROR; expr->symtree->n.sym->attr.assign = 1; @@ -3255,7 +3243,7 @@ gfc_match_goto (void) if (gfc_match (" %l%t", &label) == MATCH_YES) { - if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE) + if (!gfc_reference_st_label (label, ST_LABEL_TARGET)) return MATCH_ERROR; new_st.op = EXEC_GOTO; @@ -3267,9 +3255,7 @@ gfc_match_goto (void) if (gfc_match_variable (&expr, 0) == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F95_DEL, "Assigned GOTO " - "statement at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F95_DEL, "Assigned GOTO statement at %C")) return MATCH_ERROR; new_st.op = EXEC_GOTO; @@ -3293,7 +3279,7 @@ gfc_match_goto (void) if (m != MATCH_YES) goto syntax; - if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE) + if (!gfc_reference_st_label (label, ST_LABEL_TARGET)) goto cleanup; if (head == NULL) @@ -3338,7 +3324,7 @@ gfc_match_goto (void) if (m != MATCH_YES) goto syntax; - if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE) + if (!gfc_reference_st_label (label, ST_LABEL_TARGET)) goto cleanup; if (head == NULL) @@ -3377,8 +3363,7 @@ gfc_match_goto (void) if (gfc_match (" %e%t", &expr) != MATCH_YES) goto syntax; - if (gfc_notify_std (GFC_STD_F95_OBS, "Computed GOTO " - "at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F95_OBS, "Computed GOTO at %C")) return MATCH_ERROR; /* At this point, a computed GOTO has been fully matched and an @@ -3460,8 +3445,8 @@ gfc_match_allocate (void) { if (gfc_match (" :: ") == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F2003, "typespec in " - "ALLOCATE at %L", &old_locus) == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "typespec in ALLOCATE at %L", + &old_locus)) goto cleanup; if (ts.deferred) @@ -3516,8 +3501,8 @@ gfc_match_allocate (void) deferred_locus = tail->expr->where; } - if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS - || gfc_find_state (COMP_CRITICAL) == SUCCESS) + if (gfc_find_state (COMP_DO_CONCURRENT) + || gfc_find_state (COMP_CRITICAL)) { gfc_ref *ref; bool coarray = tail->expr->symtree->n.sym->attr.codimension; @@ -3525,12 +3510,12 @@ gfc_match_allocate (void) if (ref->type == REF_COMPONENT) coarray = ref->u.c.component->attr.codimension; - if (coarray && gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS) + if (coarray && gfc_find_state (COMP_DO_CONCURRENT)) { gfc_error ("ALLOCATE of coarray at %C in DO CONCURRENT block"); goto cleanup; } - if (coarray && gfc_find_state (COMP_CRITICAL) == SUCCESS) + if (coarray && gfc_find_state (COMP_CRITICAL)) { gfc_error ("ALLOCATE of coarray at %C in CRITICAL block"); goto cleanup; @@ -3625,8 +3610,7 @@ alloc_opt_list: goto cleanup; if (m == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F2003, "ERRMSG tag at %L", - &tmp->where) == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "ERRMSG tag at %L", &tmp->where)) goto cleanup; /* Enforce C630. */ @@ -3649,8 +3633,7 @@ alloc_opt_list: goto cleanup; if (m == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F2003, "SOURCE tag at %L", - &tmp->where) == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "SOURCE tag at %L", &tmp->where)) goto cleanup; /* Enforce C630. */ @@ -3669,9 +3652,9 @@ alloc_opt_list: } if (head->next - && gfc_notify_std (GFC_STD_F2008, "SOURCE tag at %L" - " with more than a single allocate object", - &tmp->where) == FAILURE) + && !gfc_notify_std (GFC_STD_F2008, "SOURCE tag at %L" + " with more than a single allocate object", + &tmp->where)) goto cleanup; source = tmp; @@ -3687,8 +3670,7 @@ alloc_opt_list: goto cleanup; if (m == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F2008, "MOLD tag at %L", - &tmp->where) == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "MOLD tag at %L", &tmp->where)) goto cleanup; /* Check F08:C636. */ @@ -3900,14 +3882,14 @@ gfc_match_deallocate (void) gfc_current_ns->proc_name->attr.implicit_pure = 0; if (gfc_is_coarray (tail->expr) - && gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS) + && gfc_find_state (COMP_DO_CONCURRENT)) { gfc_error ("DEALLOCATE of coarray at %C in DO CONCURRENT block"); goto cleanup; } if (gfc_is_coarray (tail->expr) - && gfc_find_state (COMP_CRITICAL) == SUCCESS) + && gfc_find_state (COMP_CRITICAL)) { gfc_error ("DEALLOCATE of coarray at %C in CRITICAL block"); goto cleanup; @@ -3962,8 +3944,7 @@ dealloc_opt_list: goto cleanup; if (m == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F2003, "ERRMSG at %L", - &tmp->where) == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "ERRMSG at %L", &tmp->where)) goto cleanup; if (saw_errmsg) @@ -4018,13 +3999,13 @@ gfc_match_return (void) e = NULL; - if (gfc_find_state (COMP_CRITICAL) == SUCCESS) + if (gfc_find_state (COMP_CRITICAL)) { gfc_error ("Image control statement RETURN at %C in CRITICAL block"); return MATCH_ERROR; } - if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS) + if (gfc_find_state (COMP_DO_CONCURRENT)) { gfc_error ("Image control statement RETURN at %C in DO CONCURRENT block"); return MATCH_ERROR; @@ -4033,7 +4014,7 @@ gfc_match_return (void) if (gfc_match_eos () == MATCH_YES) goto done; - if (gfc_find_state (COMP_SUBROUTINE) == FAILURE) + if (!gfc_find_state (COMP_SUBROUTINE)) { gfc_error ("Alternate RETURN statement at %C is only allowed within " "a SUBROUTINE"); @@ -4066,8 +4047,8 @@ cleanup: done: gfc_enclosing_unit (&s); if (s == COMP_PROGRAM - && gfc_notify_std (GFC_STD_GNU, "RETURN statement in " - "main program at %C") == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, "RETURN statement in " + "main program at %C")) return MATCH_ERROR; new_st.op = EXEC_RETURN; @@ -4178,7 +4159,7 @@ gfc_match_call (void) } /* ...and then to try to make the symbol into a subroutine. */ - if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) + if (!gfc_add_subroutine (&sym->attr, sym->name, NULL)) return MATCH_ERROR; } @@ -4231,7 +4212,7 @@ gfc_match_call (void) if (a->expr != NULL) continue; - if (gfc_reference_st_label (a->label, ST_LABEL_TARGET) == FAILURE) + if (!gfc_reference_st_label (a->label, ST_LABEL_TARGET)) continue; i++; @@ -4450,14 +4431,13 @@ gfc_match_common (void) if (((sym->value != NULL && sym->value->expr_type != EXPR_NULL) || sym->attr.data) && gfc_current_state () != COMP_BLOCK_DATA) { - if (gfc_notify_std (GFC_STD_GNU, "Initialized symbol '%s' at %C " - "can only be COMMON in " - "BLOCK DATA", sym->name) - == FAILURE) + if (!gfc_notify_std (GFC_STD_GNU, "Initialized symbol '%s' at " + "%C can only be COMMON in BLOCK DATA", + sym->name)) goto cleanup; } - if (gfc_add_in_common (&sym->attr, sym->name, NULL) == FAILURE) + if (!gfc_add_in_common (&sym->attr, sym->name, NULL)) goto cleanup; if (tail != NULL) @@ -4482,7 +4462,7 @@ gfc_match_common (void) goto cleanup; } - if (gfc_add_dimension (&sym->attr, sym->name, NULL) == FAILURE) + if (!gfc_add_dimension (&sym->attr, sym->name, NULL)) goto cleanup; if (sym->attr.pointer) @@ -4584,7 +4564,7 @@ gfc_match_block_data (void) if (gfc_get_symbol (name, NULL, &sym)) return MATCH_ERROR; - if (gfc_add_flavor (&sym->attr, FL_BLOCK_DATA, sym->name, NULL) == FAILURE) + if (!gfc_add_flavor (&sym->attr, FL_BLOCK_DATA, sym->name, NULL)) return MATCH_ERROR; gfc_new_block = sym; @@ -4635,15 +4615,14 @@ gfc_match_namelist (void) if (group_name->attr.flavor == FL_NAMELIST && group_name->attr.use_assoc - && gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' " - "at %C already is USE associated and can" - "not be respecified.", group_name->name) - == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' " + "at %C already is USE associated and can" + "not be respecified.", group_name->name)) return MATCH_ERROR; if (group_name->attr.flavor != FL_NAMELIST - && gfc_add_flavor (&group_name->attr, FL_NAMELIST, - group_name->name, NULL) == FAILURE) + && !gfc_add_flavor (&group_name->attr, FL_NAMELIST, + group_name->name, NULL)) return MATCH_ERROR; for (;;) @@ -4655,7 +4634,7 @@ gfc_match_namelist (void) goto error; if (sym->attr.in_namelist == 0 - && gfc_add_in_namelist (&sym->attr, sym->name, NULL) == FAILURE) + && !gfc_add_in_namelist (&sym->attr, sym->name, NULL)) goto error; /* Use gfc_error_check here, rather than goto error, so that @@ -4721,8 +4700,8 @@ gfc_match_module (void) if (m != MATCH_YES) return m; - if (gfc_add_flavor (&gfc_new_block->attr, FL_MODULE, - gfc_new_block->name, NULL) == FAILURE) + if (!gfc_add_flavor (&gfc_new_block->attr, FL_MODULE, + gfc_new_block->name, NULL)) return MATCH_ERROR; return MATCH_YES; @@ -4811,7 +4790,7 @@ gfc_match_equivalence (void) sym = set->expr->symtree->n.sym; - if (gfc_add_in_equivalence (&sym->attr, sym->name, NULL) == FAILURE) + if (!gfc_add_in_equivalence (&sym->attr, sym->name, NULL)) goto cleanup; if (sym->attr.in_common) @@ -4958,8 +4937,7 @@ gfc_match_st_function (void) gfc_push_error (&old_error); - if (gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION, - sym->name, NULL) == FAILURE) + if (!gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION, sym->name, NULL)) goto undo_error; if (gfc_match_formal_arglist (sym, 1, 0) != MATCH_YES) @@ -4981,8 +4959,7 @@ gfc_match_st_function (void) sym->value = expr; - if (gfc_notify_std (GFC_STD_F95_OBS, - "Statement function at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F95_OBS, "Statement function at %C")) return MATCH_ERROR; return MATCH_YES; diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 48aa405..ac8b9f8 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -195,9 +195,9 @@ match gfc_match_volatile (void); /* Fortran 2003 c interop. TODO: some of these should be moved to another file rather than decl.c */ void set_com_block_bind_c (gfc_common_head *, int); -gfc_try set_verify_bind_c_sym (gfc_symbol *, int); -gfc_try set_verify_bind_c_com_block (gfc_common_head *, int); -gfc_try get_bind_c_idents (void); +bool set_verify_bind_c_sym (gfc_symbol *, int); +bool set_verify_bind_c_com_block (gfc_common_head *, int); +bool get_bind_c_idents (void); match gfc_match_bind_c_stmt (void); match gfc_match_suffix (gfc_symbol *, gfc_symbol **); match gfc_match_bind_c (gfc_symbol *, bool); @@ -213,7 +213,7 @@ match gfc_match_literal_constant (gfc_expr **, int); /* expr.c -- FIXME: this one should be eliminated by moving the matcher to matchexp.c and a call to a new function in expr.c that only makes sure the init expr. is valid. */ -gfc_try gfc_reduce_init_expr (gfc_expr *expr); +bool gfc_reduce_init_expr (gfc_expr *expr); match gfc_match_init_expr (gfc_expr **); /* array.c. */ diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 814a40d..046ba48 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -555,8 +555,8 @@ gfc_match_use (void) { if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F2003, "module " - "nature in USE statement at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "module " + "nature in USE statement at %C")) goto cleanup; if (strcmp (module_nature, "intrinsic") == 0) @@ -590,8 +590,7 @@ gfc_match_use (void) { m = gfc_match (" ::"); if (m == MATCH_YES && - gfc_notify_std (GFC_STD_F2003, - "\"USE :: module\" at %C") == FAILURE) + !gfc_notify_std(GFC_STD_F2003, "\"USE :: module\" at %C")) goto cleanup; if (m != MATCH_YES) @@ -658,9 +657,8 @@ gfc_match_use (void) m = gfc_match (" =>"); if (type == INTERFACE_USER_OP && m == MATCH_YES - && (gfc_notify_std (GFC_STD_F2003, "Renaming " - "operators in USE statements at %C") - == FAILURE)) + && (!gfc_notify_std(GFC_STD_F2003, "Renaming " + "operators in USE statements at %C"))) goto cleanup; if (type == INTERFACE_USER_OP) @@ -4089,7 +4087,7 @@ load_generic_interfaces (void) if (st && !sym->attr.generic && !st->ambiguous && sym->module - && strcmp(module, sym->module)) + && strcmp (module, sym->module)) { ambiguous_set = true; st->ambiguous = 1; @@ -6096,10 +6094,9 @@ use_iso_fortran_env_module (void) found = true; u->found = 1; - if (gfc_notify_std (symbol[i].standard, "The symbol '%s', " - "referenced at %L, is not in the selected " - "standard", symbol[i].name, - &u->where) == FAILURE) + if (!gfc_notify_std (symbol[i].standard, "The symbol '%s', " + "referenced at %L, is not in the selected " + "standard", symbol[i].name, &u->where)) continue; if ((gfc_option.flag_default_integer || gfc_option.flag_default_real) @@ -6265,7 +6262,7 @@ gfc_use_module (gfc_use_list *module) { if (strcmp (module_name, "iso_fortran_env") == 0 && gfc_notify_std (GFC_STD_F2003, "ISO_FORTRAN_ENV " - "intrinsic module at %C") != FAILURE) + "intrinsic module at %C")) { use_iso_fortran_env_module (); free_rename (module->rename); @@ -6276,8 +6273,7 @@ gfc_use_module (gfc_use_list *module) } if (strcmp (module_name, "iso_c_binding") == 0 - && gfc_notify_std (GFC_STD_F2003, - "ISO_C_BINDING module at %C") != FAILURE) + && gfc_notify_std (GFC_STD_F2003, "ISO_C_BINDING module at %C")) { import_iso_c_binding_module(); free_rename (module->rename); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 05de49b..865f836 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -316,9 +316,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) && ! sym->attr.intrinsic && ! sym->attr.use_assoc && ((sym->attr.flavor == FL_UNKNOWN - && gfc_add_flavor (&sym->attr, FL_PROCEDURE, - sym->name, NULL) == FAILURE) - || gfc_add_intrinsic (&sym->attr, NULL) == FAILURE)) + && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL)) + || !gfc_add_intrinsic (&sym->attr, NULL))) { gfc_free_omp_clauses (c); return MATCH_ERROR; @@ -573,8 +572,7 @@ gfc_match_omp_threadprivate (void) if (sym->attr.in_common) gfc_error_now ("Threadprivate variable at %C is an element of " "a COMMON block"); - else if (gfc_add_threadprivate (&sym->attr, sym->name, - &sym->declared_at) == FAILURE) + else if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at)) goto cleanup; goto next_item; case MATCH_NO: @@ -597,8 +595,7 @@ gfc_match_omp_threadprivate (void) } st->n.common->threadprivate = 1; for (sym = st->n.common->head; sym; sym = sym->common_next) - if (gfc_add_threadprivate (&sym->attr, sym->name, - &sym->declared_at) == FAILURE) + if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at)) goto cleanup; next_item: @@ -814,7 +811,7 @@ resolve_omp_clauses (gfc_code *code) if (omp_clauses->if_expr) { gfc_expr *expr = omp_clauses->if_expr; - if (gfc_resolve_expr (expr) == FAILURE + if (!gfc_resolve_expr (expr) || expr->ts.type != BT_LOGICAL || expr->rank != 0) gfc_error ("IF clause at %L requires a scalar LOGICAL expression", &expr->where); @@ -822,7 +819,7 @@ resolve_omp_clauses (gfc_code *code) if (omp_clauses->final_expr) { gfc_expr *expr = omp_clauses->final_expr; - if (gfc_resolve_expr (expr) == FAILURE + if (!gfc_resolve_expr (expr) || expr->ts.type != BT_LOGICAL || expr->rank != 0) gfc_error ("FINAL clause at %L requires a scalar LOGICAL expression", &expr->where); @@ -830,7 +827,7 @@ resolve_omp_clauses (gfc_code *code) if (omp_clauses->num_threads) { gfc_expr *expr = omp_clauses->num_threads; - if (gfc_resolve_expr (expr) == FAILURE + if (!gfc_resolve_expr (expr) || expr->ts.type != BT_INTEGER || expr->rank != 0) gfc_error ("NUM_THREADS clause at %L requires a scalar " "INTEGER expression", &expr->where); @@ -838,7 +835,7 @@ resolve_omp_clauses (gfc_code *code) if (omp_clauses->chunk_size) { gfc_expr *expr = omp_clauses->chunk_size; - if (gfc_resolve_expr (expr) == FAILURE + if (!gfc_resolve_expr (expr) || expr->ts.type != BT_INTEGER || expr->rank != 0) gfc_error ("SCHEDULE clause's chunk_size at %L requires " "a scalar INTEGER expression", &expr->where); diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index a7fa7dc..6dde0c6 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -100,7 +100,7 @@ use_modules (void) #define match(keyword, subr, st) \ do { \ - if (match_word(keyword, subr, &old_locus) == MATCH_YES) \ + if (match_word (keyword, subr, &old_locus) == MATCH_YES) \ return st; \ else \ undo_new_statement (); \ @@ -1068,7 +1068,7 @@ pop_state (void) /* Try to find the given state in the state stack. */ -gfc_try +bool gfc_find_state (gfc_compile_state state) { gfc_state_data *p; @@ -1077,7 +1077,7 @@ gfc_find_state (gfc_compile_state state) if (p->state == state) break; - return (p == NULL) ? FAILURE : SUCCESS; + return (p == NULL) ? false : true; } @@ -1763,7 +1763,7 @@ unexpected_statement (gfc_statement st) /* Given the next statement seen by the matcher, make sure that it is in proper order with the last. This subroutine is initialized by calling it with an argument of ST_NONE. If there is a problem, we - issue an error and return FAILURE. Otherwise we return SUCCESS. + issue an error and return false. Otherwise we return true. Individual parsers need to verify that the statements seen are valid before calling here, i.e., ENTRY statements are not allowed in @@ -1815,7 +1815,7 @@ typedef struct } st_state; -static gfc_try +static bool verify_st_order (st_state *p, gfc_statement st, bool silent) { @@ -1897,7 +1897,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent) /* All is well, record the statement in case we need it next time. */ p->where = gfc_current_locus; p->last_statement = st; - return SUCCESS; + return true; order: if (!silent) @@ -1905,7 +1905,7 @@ order: gfc_ascii_statement (st), gfc_ascii_statement (p->last_statement), &p->where); - return FAILURE; + return false; } @@ -1977,8 +1977,7 @@ parse_derived_contains (void) goto error; case ST_PROCEDURE: - if (gfc_notify_std (GFC_STD_F2003, "Type-bound" - " procedure at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "Type-bound procedure at %C")) goto error; accept_statement (ST_PROCEDURE); @@ -1986,8 +1985,7 @@ parse_derived_contains (void) break; case ST_GENERIC: - if (gfc_notify_std (GFC_STD_F2003, "GENERIC binding" - " at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "GENERIC binding at %C")) goto error; accept_statement (ST_GENERIC); @@ -1995,9 +1993,8 @@ parse_derived_contains (void) break; case ST_FINAL: - if (gfc_notify_std (GFC_STD_F2003, - "FINAL procedure declaration" - " at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "FINAL procedure declaration" + " at %C")) goto error; accept_statement (ST_FINAL); @@ -2008,16 +2005,15 @@ parse_derived_contains (void) to_finish = true; if (!seen_comps - && (gfc_notify_std (GFC_STD_F2008, "Derived type " - "definition at %C with empty CONTAINS " - "section") == FAILURE)) + && (!gfc_notify_std(GFC_STD_F2008, "Derived type definition " + "at %C with empty CONTAINS section"))) goto error; /* ST_END_TYPE is accepted by parse_derived after return. */ break; case ST_PRIVATE: - if (gfc_find_state (COMP_MODULE) == FAILURE) + if (!gfc_find_state (COMP_MODULE)) { gfc_error ("PRIVATE statement in TYPE at %C must be inside " "a MODULE"); @@ -2120,7 +2116,7 @@ endType: break; case ST_PRIVATE: - if (gfc_find_state (COMP_MODULE) == FAILURE) + if (!gfc_find_state (COMP_MODULE)) { gfc_error ("PRIVATE statement in TYPE at %C must be inside " "a MODULE"); @@ -2395,8 +2391,8 @@ loop: gfc_new_block->attr.pointer = 0; gfc_new_block->attr.proc_pointer = 1; } - if (gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, - gfc_new_block->formal, NULL) == FAILURE) + if (!gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, + gfc_new_block->formal, NULL)) { reject_statement (); gfc_free_namespace (gfc_current_ns); @@ -2642,7 +2638,7 @@ loop: verify_st_order (&dummyss, ST_NONE, false); verify_st_order (&dummyss, st, false); - if (verify_st_order (&dummyss, ST_IMPLICIT, true) == FAILURE) + if (!verify_st_order (&dummyss, ST_IMPLICIT, true)) verify_now = true; } @@ -2683,7 +2679,7 @@ loop: case ST_DERIVED_DECL: case_decl: declSt: - if (verify_st_order (&ss, st, false) == FAILURE) + if (!verify_st_order (&ss, st, false)) { reject_statement (); st = next_statement (); @@ -3313,14 +3309,14 @@ gfc_build_block_ns (gfc_namespace *parent_ns) my_ns->proc_name = gfc_new_block; else { - gfc_try t; + bool t; char buffer[20]; /* Enough to hold "block@2147483648\n". */ snprintf(buffer, sizeof(buffer), "block@%d", numblock++); gfc_get_symbol (buffer, my_ns, &my_ns->proc_name); t = gfc_add_flavor (&my_ns->proc_name->attr, FL_LABEL, my_ns->proc_name->name, NULL); - gcc_assert (t == SUCCESS); + gcc_assert (t); gfc_commit_symbol (my_ns->proc_name); } @@ -4026,9 +4022,9 @@ parse_contained (int module) "ambiguous", gfc_new_block->name); else { - if (gfc_add_procedure (&sym->attr, PROC_INTERNAL, sym->name, - &gfc_new_block->declared_at) == - SUCCESS) + if (gfc_add_procedure (&sym->attr, PROC_INTERNAL, + sym->name, + &gfc_new_block->declared_at)) { if (st == ST_FUNCTION) gfc_add_function (&sym->attr, sym->name, @@ -4174,7 +4170,7 @@ contains: if (p->state == COMP_CONTAINS) n++; - if (gfc_find_state (COMP_MODULE) == SUCCESS) + if (gfc_find_state (COMP_MODULE) == true) n--; if (n > 0) @@ -4492,7 +4488,7 @@ translate_all_program_units (gfc_namespace *gfc_global_ns_list, /* Top level parser. */ -gfc_try +bool gfc_parse_file (void) { int seen_program, errors_before, errors; @@ -4516,7 +4512,7 @@ gfc_parse_file (void) gfc_statement_label = NULL; if (setjmp (eof_buf)) - return FAILURE; /* Come here on unexpected EOF */ + return false; /* Come here on unexpected EOF */ /* Prepare the global namespace that will contain the program units. */ @@ -4663,7 +4659,7 @@ prog_units: translate_all_program_units (gfc_global_ns_list, seen_program); gfc_end_source_files (); - return SUCCESS; + return true; duplicate_main: /* If we see a duplicate main program, shut down. If the second @@ -4672,5 +4668,5 @@ duplicate_main: gfc_error ("Two main PROGRAMs at %L and %C", &prog_locus); reject_statement (); gfc_done_2 (); - return SUCCESS; + return true; } diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h index dbe3c49..acafe6c 100644 --- a/gcc/fortran/parse.h +++ b/gcc/fortran/parse.h @@ -60,7 +60,7 @@ extern gfc_state_data *gfc_state_stack; #define gfc_current_state() (gfc_state_stack->state) int gfc_check_do_variable (gfc_symtree *); -gfc_try gfc_find_state (gfc_compile_state); +bool gfc_find_state (gfc_compile_state); gfc_state_data *gfc_enclosing_unit (gfc_compile_state *); const char *gfc_ascii_statement (gfc_statement); match gfc_match_enum (void); diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 6664dd2..cd8a417 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -267,8 +267,7 @@ match_hollerith_constant (gfc_expr **result) if (match_integer_constant (&e, 0) == MATCH_YES && gfc_match_char ('h') == MATCH_YES) { - if (gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant " - "at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant at %C")) goto cleanup; msg = gfc_extract_int (e, &num); @@ -391,9 +390,8 @@ match_boz_constant (gfc_expr **result) goto backup; if (x_hex - && (gfc_notify_std (GFC_STD_GNU, "Hexadecimal " - "constant at %C uses non-standard syntax") - == FAILURE)) + && (!gfc_notify_std(GFC_STD_GNU, "Hexadecimal " + "constant at %C uses non-standard syntax"))) return MATCH_ERROR; old_loc = gfc_current_locus; @@ -430,9 +428,8 @@ match_boz_constant (gfc_expr **result) goto backup; } - if (gfc_notify_std (GFC_STD_GNU, "BOZ constant " - "at %C uses non-standard postfix syntax") - == FAILURE) + if (!gfc_notify_std (GFC_STD_GNU, "BOZ constant " + "at %C uses non-standard postfix syntax")) return MATCH_ERROR; } @@ -467,9 +464,8 @@ match_boz_constant (gfc_expr **result) } if (!gfc_in_match_data () - && (gfc_notify_std (GFC_STD_F2003, "BOZ used outside a DATA " - "statement at %C") - == FAILURE)) + && (!gfc_notify_std(GFC_STD_F2003, "BOZ used outside a DATA " + "statement at %C"))) return MATCH_ERROR; *result = e; @@ -558,8 +554,8 @@ match_real_constant (gfc_expr **result, int signflag) if (c == 'q') { - if (gfc_notify_std (GFC_STD_GNU, "exponent-letter 'q' in " - "real-literal-constant at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_GNU, "exponent-letter 'q' in " + "real-literal-constant at %C")) return MATCH_ERROR; else if (gfc_option.warn_real_q_constant) gfc_warning("Extension: exponent-letter 'q' in real-literal-constant " @@ -1217,8 +1213,8 @@ match_sym_complex_part (gfc_expr **result) return MATCH_ERROR; } - if (gfc_notify_std (GFC_STD_F2003, "PARAMETER symbol in " - "complex constant at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "PARAMETER symbol in " + "complex constant at %C")) return MATCH_ERROR; switch (sym->value->ts.type) @@ -1506,8 +1502,8 @@ match_actual_arg (gfc_expr **result) if (sym->attr.in_common && !sym->attr.proc_pointer) { - if (gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, - &sym->declared_at) == FAILURE) + if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, + sym->name, &sym->declared_at)) return MATCH_ERROR; break; } @@ -1646,8 +1642,7 @@ match_arg_list_function (gfc_actual_arglist *result) } } - if (gfc_notify_std (GFC_STD_GNU, "argument list " - "function at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_GNU, "argument list function at %C")) { m = MATCH_ERROR; goto cleanup; @@ -1719,8 +1714,8 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp) if (m != MATCH_YES) goto cleanup; - if (gfc_notify_std (GFC_STD_F95_OBS, "Alternate-return argument " - "at %C") == FAILURE) + if (!gfc_notify_std (GFC_STD_F95_OBS, "Alternate-return argument " + "at %C")) goto cleanup; tail->label = label; @@ -1936,7 +1931,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, for (;;) { - gfc_try t; + bool t; gfc_symtree *tbp; m = gfc_match_name (name); @@ -1954,7 +1949,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, { gfc_symbol* tbp_sym; - if (t == FAILURE) + if (!t) return MATCH_ERROR; gcc_assert (!tail || !tail->next); @@ -2311,7 +2306,7 @@ gfc_free_structure_ctor_component (gfc_structure_ctor_component *comp) the order required; this also checks along the way that each and every component actually has an initializer and handles default initializers for components without explicit value given. */ -static gfc_try +static bool build_actual_constructor (gfc_structure_ctor_component **comp_head, gfc_constructor_base *ctor_head, gfc_symbol *sym) { @@ -2341,11 +2336,12 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, &gfc_current_locus); value->ts = comp->ts; - if (build_actual_constructor (comp_head, &value->value.constructor, - comp->ts.u.derived) == FAILURE) + if (!build_actual_constructor (comp_head, + &value->value.constructor, + comp->ts.u.derived)) { gfc_free_expr (value); - return FAILURE; + return false; } gfc_constructor_append_expr (ctor_head, value, NULL); @@ -2358,17 +2354,16 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, { if (comp->initializer) { - if (gfc_notify_std (GFC_STD_F2003, "Structure" - " constructor with missing optional arguments" - " at %C") == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2003, "Structure constructor " + "with missing optional arguments at %C")) + return false; value = gfc_copy_expr (comp->initializer); } else { gfc_error ("No initializer for component '%s' given in the" " structure constructor at %C!", comp->name); - return FAILURE; + return false; } } else @@ -2386,11 +2381,11 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, gfc_free_structure_ctor_component (comp_iter); } } - return SUCCESS; + return true; } -gfc_try +bool gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **cexpr, gfc_actual_arglist **arglist, bool parent) @@ -2434,9 +2429,8 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c } if (actual->name) { - if (gfc_notify_std (GFC_STD_F2003, "Structure" - " constructor with named arguments at %C") - == FAILURE) + if (!gfc_notify_std (GFC_STD_F2003, "Structure" + " constructor with named arguments at %C")) goto cleanup; comp_tail->name = xstrdup (actual->name); @@ -2519,7 +2513,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c || comp_tail->val->ts.u.derived != this_comp->ts.u.derived)) { - gfc_try m; + bool m; gfc_actual_arglist *arg_null = NULL; actual->expr = comp_tail->val; @@ -2529,7 +2523,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c comp->ts.u.derived, &comp_tail->val, comp->ts.u.derived->attr.zero_comp ? &arg_null : &actual, true); - if (m == FAILURE) + if (!m) goto cleanup; if (comp->ts.u.derived->attr.zero_comp) @@ -2547,7 +2541,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c actual = actual->next; } - if (build_actual_constructor (&comp_head, &ctor_head, sym) == FAILURE) + if (!build_actual_constructor (&comp_head, &ctor_head, sym)) goto cleanup; /* No component should be left, as this should have caused an error in the @@ -2585,7 +2579,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c gfc_current_locus = old_locus; if (parent) *arglist = actual; - return SUCCESS; + return true; cleanup: gfc_current_locus = old_locus; @@ -2598,7 +2592,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c } gfc_constructor_free (ctor_head); - return FAILURE; + return false; } @@ -2627,8 +2621,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result) return m; } - if (gfc_convert_to_structure_constructor (e, sym, NULL, NULL, false) - != SUCCESS) + if (!gfc_convert_to_structure_constructor (e, sym, NULL, NULL, false)) { gfc_free_expr (e); return MATCH_ERROR; @@ -2664,7 +2657,7 @@ check_for_implicit_index (gfc_symtree **st, gfc_symbol **sym) /* Procedure pointer as function result: Replace the function symbol by the auto-generated hidden result variable named "ppr@". */ -static gfc_try +static bool replace_hidden_procptr_result (gfc_symbol **sym, gfc_symtree **st) { /* Check for procedure pointer result variable. */ @@ -2679,9 +2672,9 @@ replace_hidden_procptr_result (gfc_symbol **sym, gfc_symtree **st) (*sym)->result->attr.referenced = (*sym)->attr.referenced; *sym = (*sym)->result; *st = gfc_find_symtree ((*sym)->ns->sym_root, (*sym)->name); - return SUCCESS; + return true; } - return FAILURE; + return false; } @@ -2708,7 +2701,7 @@ gfc_match_rvalue (gfc_expr **result) if (m != MATCH_YES) return m; - if (gfc_find_state (COMP_INTERFACE) == SUCCESS + if (gfc_find_state (COMP_INTERFACE) && !gfc_current_ns->has_import_set) i = gfc_get_sym_tree (name, NULL, &symtree, false); else @@ -2854,8 +2847,7 @@ gfc_match_rvalue (gfc_expr **result) m = gfc_match_varspec (e, 0, false, true); if (!e->ref && sym->attr.flavor == FL_UNKNOWN && sym->ts.type == BT_UNKNOWN - && gfc_add_flavor (&sym->attr, FL_PROCEDURE, - sym->name, NULL) == FAILURE) + && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL)) { m = MATCH_ERROR; break; @@ -2930,7 +2922,7 @@ gfc_match_rvalue (gfc_expr **result) e->rank = sym->as->rank; if (!sym->attr.function - && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE) + && !gfc_add_function (&sym->attr, sym->name, NULL)) { m = MATCH_ERROR; break; @@ -2977,8 +2969,7 @@ gfc_match_rvalue (gfc_expr **result) if (sym->attr.dimension || sym->attr.codimension) { - if (gfc_add_flavor (&sym->attr, FL_VARIABLE, - sym->name, NULL) == FAILURE) + if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL)) { m = MATCH_ERROR; break; @@ -2995,8 +2986,7 @@ gfc_match_rvalue (gfc_expr **result) && (CLASS_DATA (sym)->attr.dimension || CLASS_DATA (sym)->attr.codimension)) { - if (gfc_add_flavor (&sym->attr, FL_VARIABLE, - sym->name, NULL) == FAILURE) + if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL)) { m = MATCH_ERROR; break; @@ -3021,8 +3011,7 @@ gfc_match_rvalue (gfc_expr **result) e->symtree = symtree; e->expr_type = EXPR_VARIABLE; - if (gfc_add_flavor (&sym->attr, FL_VARIABLE, - sym->name, NULL) == FAILURE) + if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL)) { m = MATCH_ERROR; break; @@ -3069,15 +3058,15 @@ gfc_match_rvalue (gfc_expr **result) e->expr_type = EXPR_VARIABLE; if (sym->attr.flavor != FL_VARIABLE - && gfc_add_flavor (&sym->attr, FL_VARIABLE, - sym->name, NULL) == FAILURE) + && !gfc_add_flavor (&sym->attr, FL_VARIABLE, + sym->name, NULL)) { m = MATCH_ERROR; break; } if (sym->ts.type == BT_UNKNOWN - && gfc_set_default_type (sym, 1, NULL) == FAILURE) + && !gfc_set_default_type (sym, 1, NULL)) { m = MATCH_ERROR; break; @@ -3098,7 +3087,7 @@ gfc_match_rvalue (gfc_expr **result) e->expr_type = EXPR_FUNCTION; if (!sym->attr.function - && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE) + && !gfc_add_function (&sym->attr, sym->name, NULL)) { m = MATCH_ERROR; break; @@ -3233,7 +3222,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) flavor = FL_VARIABLE; if (flavor != FL_UNKNOWN - && gfc_add_flavor (&sym->attr, flavor, sym->name, NULL) == FAILURE) + && !gfc_add_flavor (&sym->attr, flavor, sym->name, NULL)) return MATCH_ERROR; } break; @@ -3269,7 +3258,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) } if (sym->attr.proc_pointer - || replace_hidden_procptr_result (&sym, &st) == SUCCESS) + || replace_hidden_procptr_result (&sym, &st)) break; /* Fall through to error */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 835b57f..9098d2c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -114,7 +114,7 @@ is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns) an ABSTRACT derived-type. If where is not NULL, an error message with that locus is printed, optionally using name. */ -static gfc_try +static bool resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name) { if (ts->type == BT_DERIVED && ts->u.derived->attr.abstract) @@ -129,14 +129,14 @@ resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name) ts->u.derived->name, where); } - return FAILURE; + return false; } - return SUCCESS; + return true; } -static gfc_try +static bool check_proc_interface (gfc_symbol *ifc, locus *where) { /* Several checks for F08:C1216. */ @@ -144,7 +144,7 @@ check_proc_interface (gfc_symbol *ifc, locus *where) { gfc_error ("Interface '%s' at %L is declared " "in a later PROCEDURE statement", ifc->name, where); - return FAILURE; + return false; } if (ifc->generic) { @@ -157,14 +157,14 @@ check_proc_interface (gfc_symbol *ifc, locus *where) { gfc_error ("Interface '%s' at %L may not be generic", ifc->name, where); - return FAILURE; + return false; } } if (ifc->attr.proc == PROC_ST_FUNCTION) { gfc_error ("Interface '%s' at %L may not be a statement function", ifc->name, where); - return FAILURE; + return false; } if (gfc_is_intrinsic (ifc, 0, ifc->declared_at) || gfc_is_intrinsic (ifc, 1, ifc->declared_at)) @@ -173,14 +173,14 @@ check_proc_interface (gfc_symbol *ifc, locus *where) { gfc_error ("Intrinsic procedure '%s' not allowed in " "PROCEDURE statement at %L", ifc->name, where); - return FAILURE; + return false; } if (!ifc->attr.if_source && !ifc->attr.intrinsic && ifc->name[0] != '\0') { gfc_error ("Interface '%s' at %L must be explicit", ifc->name, where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -189,22 +189,22 @@ static void resolve_symbol (gfc_symbol *sym); /* Resolve the interface for a PROCEDURE declaration or procedure pointer. */ -static gfc_try +static bool resolve_procedure_interface (gfc_symbol *sym) { gfc_symbol *ifc = sym->ts.interface; if (!ifc) - return SUCCESS; + return true; if (ifc == sym) { gfc_error ("PROCEDURE '%s' at %L may not be used as its own interface", sym->name, &sym->declared_at); - return FAILURE; + return false; } - if (check_proc_interface (ifc, &sym->declared_at) == FAILURE) - return FAILURE; + if (!check_proc_interface (ifc, &sym->declared_at)) + return false; if (ifc->attr.if_source || ifc->attr.intrinsic) { @@ -242,12 +242,12 @@ resolve_procedure_interface (gfc_symbol *sym) { sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); if (sym->ts.u.cl->length && !sym->ts.u.cl->resolved - && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE) - return FAILURE; + && !gfc_resolve_expr (sym->ts.u.cl->length)) + return false; } } - return SUCCESS; + return true; } @@ -303,7 +303,7 @@ resolve_formal_arglist (gfc_symbol *proc) continue; } else if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL - && resolve_procedure_interface (sym) == FAILURE) + && !resolve_procedure_interface (sym)) return; if (sym->attr.if_source != IFSRC_UNKNOWN) @@ -412,7 +412,7 @@ resolve_formal_arglist (gfc_symbol *proc) { if (sym->attr.flavor == FL_PROCEDURE) { - if (!gfc_pure(sym)) + if (!gfc_pure (sym)) proc->attr.implicit_pure = 0; } else if (!sym->attr.pointer) @@ -543,7 +543,7 @@ resolve_formal_arglists (gfc_namespace *ns) static void resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) { - gfc_try t; + bool t; /* If this namespace is not a function or an entry master function, ignore it. */ @@ -556,7 +556,7 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) { t = gfc_set_default_type (sym->result, 0, ns); - if (t == FAILURE && !sym->result->attr.untyped) + if (!t && !sym->result->attr.untyped) { if (sym->result == sym) gfc_error ("Contained function '%s' at %L has no IMPLICIT type", @@ -1016,22 +1016,22 @@ resolve_contained_functions (gfc_namespace *ns) } -static gfc_try resolve_fl_derived0 (gfc_symbol *sym); +static bool resolve_fl_derived0 (gfc_symbol *sym); /* Resolve all of the elements of a structure constructor and make sure that the types are correct. The 'init' flag indicates that the given constructor is an initializer. */ -static gfc_try +static bool resolve_structure_cons (gfc_expr *expr, int init) { gfc_constructor *cons; gfc_component *comp; - gfc_try t; + bool t; symbol_attribute a; - t = SUCCESS; + t = true; if (expr->ts.type == BT_DERIVED) resolve_fl_derived0 (expr->ts.u.derived); @@ -1053,9 +1053,9 @@ resolve_structure_cons (gfc_expr *expr, int init) if (!cons->expr) continue; - if (gfc_resolve_expr (cons->expr) == FAILURE) + if (!gfc_resolve_expr (cons->expr)) { - t = FAILURE; + t = false; continue; } @@ -1067,7 +1067,7 @@ resolve_structure_cons (gfc_expr *expr, int init) "constructor at %L does not match that of the " "component (%d/%d)", &cons->expr->where, cons->expr->rank, rank); - t = FAILURE; + t = false; } /* If we don't have the right type, try to convert it. */ @@ -1089,12 +1089,12 @@ resolve_structure_cons (gfc_expr *expr, int init) &cons->expr->where, comp->name, gfc_basic_typename (cons->expr->ts.type), gfc_basic_typename (comp->ts.type)); - t = FAILURE; + t = false; } else { - gfc_try t2 = gfc_convert_type (cons->expr, &comp->ts, 1); - if (t != FAILURE) + bool t2 = gfc_convert_type (cons->expr, &comp->ts, 1); + if (t) t = t2; } } @@ -1168,7 +1168,7 @@ resolve_structure_cons (gfc_expr *expr, int init) && (CLASS_DATA (comp)->attr.class_pointer || CLASS_DATA (comp)->attr.allocatable)))) { - t = FAILURE; + t = false; gfc_error ("The NULL in the structure constructor at %L is " "being applied to component '%s', which is neither " "a POINTER nor ALLOCATABLE", &cons->expr->where, @@ -1206,7 +1206,7 @@ resolve_structure_cons (gfc_expr *expr, int init) gfc_error ("Interface mismatch for procedure-pointer component " "'%s' in structure constructor at %L: %s", comp->name, &cons->expr->where, err); - return FAILURE; + return false; } } @@ -1218,7 +1218,7 @@ resolve_structure_cons (gfc_expr *expr, int init) if (!a.pointer && !a.target) { - t = FAILURE; + t = false; gfc_error ("The element in the structure constructor at %L, " "for pointer component '%s' should be a POINTER or " "a TARGET", &cons->expr->where, comp->name); @@ -1229,13 +1229,13 @@ resolve_structure_cons (gfc_expr *expr, int init) /* F08:C461. Additional checks for pointer initialization. */ if (a.allocatable) { - t = FAILURE; + t = false; gfc_error ("Pointer initialization target at %L " "must not be ALLOCATABLE ", &cons->expr->where); } if (!a.save) { - t = FAILURE; + t = false; gfc_error ("Pointer initialization target at %L " "must have the SAVE attribute", &cons->expr->where); } @@ -1246,7 +1246,7 @@ resolve_structure_cons (gfc_expr *expr, int init) && (gfc_impure_variable (cons->expr->symtree->n.sym) || gfc_is_coindexed (cons->expr))) { - t = FAILURE; + t = false; gfc_error ("Invalid expression in the structure constructor for " "pointer component '%s' at %L in PURE procedure", comp->name, &cons->expr->where); @@ -1527,18 +1527,18 @@ is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context) /* Resolve an intrinsic procedure: Set its function/subroutine attribute, its typespec and formal argument list. */ -gfc_try +bool gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc) { gfc_intrinsic_sym* isym = NULL; const char* symstd; if (sym->formal) - return SUCCESS; + return true; /* Already resolved. */ if (sym->from_intmod && sym->ts.type != BT_UNKNOWN) - return SUCCESS; + return true; /* We already know this one is an intrinsic, so we don't call gfc_is_intrinsic for full checking but rather use gfc_find_function and @@ -1566,8 +1566,8 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc) " ignored", sym->name, &sym->declared_at); if (!sym->attr.function && - gfc_add_function (&sym->attr, sym->name, loc) == FAILURE) - return FAILURE; + !gfc_add_function(&sym->attr, sym->name, loc)) + return false; sym->ts = isym->ts; } @@ -1577,48 +1577,47 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc) { gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type" " specifier", sym->name, &sym->declared_at); - return FAILURE; + return false; } if (!sym->attr.subroutine && - gfc_add_subroutine (&sym->attr, sym->name, loc) == FAILURE) - return FAILURE; + !gfc_add_subroutine(&sym->attr, sym->name, loc)) + return false; } else { gfc_error ("'%s' declared INTRINSIC at %L does not exist", sym->name, &sym->declared_at); - return FAILURE; + return false; } gfc_copy_formal_args_intr (sym, isym); /* Check it is actually available in the standard settings. */ - if (gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at) - == FAILURE) + if (!gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at)) { gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not" " available in the current standard settings but %s. Use" " an appropriate -std=* option or enable -fall-intrinsics" " in order to use it.", sym->name, &sym->declared_at, symstd); - return FAILURE; + return false; } - return SUCCESS; + return true; } /* Resolve a procedure expression, like passing it to a called procedure or as RHS for a procedure pointer assignment. */ -static gfc_try +static bool resolve_procedure_expression (gfc_expr* expr) { gfc_symbol* sym; if (expr->expr_type != EXPR_VARIABLE) - return SUCCESS; + return true; gcc_assert (expr->symtree); sym = expr->symtree->n.sym; @@ -1628,7 +1627,7 @@ resolve_procedure_expression (gfc_expr* expr) if (sym->attr.flavor != FL_PROCEDURE || (sym->attr.function && sym->result == sym)) - return SUCCESS; + return true; /* A non-RECURSIVE procedure that is used as procedure expression within its own body is in danger of being called recursively. */ @@ -1637,7 +1636,7 @@ resolve_procedure_expression (gfc_expr* expr) " itself recursively. Declare it RECURSIVE or use" " -frecursive", sym->name, &expr->where); - return SUCCESS; + return true; } @@ -1647,7 +1646,7 @@ resolve_procedure_expression (gfc_expr* expr) that look like procedure arguments are really simple variable references. */ -static gfc_try +static bool resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, bool no_formal_args) { @@ -1655,7 +1654,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, gfc_symtree *parent_st; gfc_expr *e; int save_need_full_assumed_size; - gfc_try return_value = FAILURE; + bool return_value = false; bool actual_arg_sav = actual_arg, first_actual_arg_sav = first_actual_arg; actual_arg = true; @@ -1691,7 +1690,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, save_need_full_assumed_size = need_full_assumed_size; if (e->expr_type != EXPR_VARIABLE) need_full_assumed_size = 0; - if (gfc_resolve_expr (e) != SUCCESS) + if (!gfc_resolve_expr (e)) goto cleanup; need_full_assumed_size = save_need_full_assumed_size; goto argument_list; @@ -1729,10 +1728,9 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, if (sym->attr.contained && !sym->attr.use_assoc && sym->ns->proc_name->attr.flavor != FL_MODULE) { - if (gfc_notify_std (GFC_STD_F2008, - "Internal procedure '%s' is" - " used as actual argument at %L", - sym->name, &e->where) == FAILURE) + if (!gfc_notify_std (GFC_STD_F2008, "Internal procedure '%s' is" + " used as actual argument at %L", + sym->name, &e->where)) goto cleanup; } @@ -1775,7 +1773,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, sym->attr.function = 1; } - if (gfc_resolve_expr (e) == FAILURE) + if (!gfc_resolve_expr (e)) goto cleanup; goto argument_list; } @@ -1801,7 +1799,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, || sym->attr.intrinsic || sym->attr.external) { - if (gfc_resolve_expr (e) == FAILURE) + if (!gfc_resolve_expr (e)) goto cleanup; goto argument_list; } @@ -1829,7 +1827,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, save_need_full_assumed_size = need_full_assumed_size; if (e->expr_type != EXPR_VARIABLE) need_full_assumed_size = 0; - if (gfc_resolve_expr (e) != SUCCESS) + if (!gfc_resolve_expr (e)) goto cleanup; need_full_assumed_size = save_need_full_assumed_size; @@ -1894,7 +1892,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, first_actual_arg = false; } - return_value = SUCCESS; + return_value = true; cleanup: actual_arg = actual_arg_sav; @@ -1908,7 +1906,7 @@ cleanup: procedures. If called with c == NULL, we have a function, otherwise if expr == NULL, we have a subroutine. */ -static gfc_try +static bool resolve_elemental_actual (gfc_expr *expr, gfc_code *c) { gfc_actual_arglist *arg0; @@ -1939,7 +1937,7 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) isym = expr->value.function.isym; } else - return SUCCESS; + return true; } else if (c && c->ext.actual != NULL) { @@ -1952,10 +1950,10 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) gcc_assert (esym); if (!esym->attr.elemental) - return SUCCESS; + return true; } else - return SUCCESS; + return true; /* The rank of an elemental is the rank of its array argument(s). */ for (arg = arg0; arg; arg = arg->next) @@ -2033,14 +2031,13 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) /* Being elemental, the last upper bound of an assumed size array argument must be present. */ if (resolve_assumed_size_actual (arg->expr)) - return FAILURE; + return false; /* Elemental procedure's array actual arguments must conform. */ if (e != NULL) { - if (gfc_check_conformance (arg->expr, e, - "elemental procedure") == FAILURE) - return FAILURE; + if (!gfc_check_conformance (arg->expr, e, "elemental procedure")) + return false; } else e = arg->expr; @@ -2060,9 +2057,9 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) "actual argument is an array", &arg->expr->where, (eformal->sym->attr.intent == INTENT_OUT) ? "OUT" : "INOUT", eformal->sym->name, esym->name); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -2419,7 +2416,7 @@ resolve_generic_f0 (gfc_expr *expr, gfc_symbol *sym) } -static gfc_try +static bool resolve_generic_f (gfc_expr *expr) { gfc_symbol *sym; @@ -2432,9 +2429,9 @@ resolve_generic_f (gfc_expr *expr) { m = resolve_generic_f0 (expr, sym); if (m == MATCH_YES) - return SUCCESS; + return true; else if (m == MATCH_ERROR) - return FAILURE; + return false; generic: if (!intr) @@ -2458,27 +2455,27 @@ generic: { gfc_error ("There is no specific function for the generic '%s' " "at %L", expr->symtree->n.sym->name, &expr->where); - return FAILURE; + return false; } if (intr) { - if (gfc_convert_to_structure_constructor (expr, intr->sym, NULL, NULL, - false) != SUCCESS) - return FAILURE; + if (!gfc_convert_to_structure_constructor (expr, intr->sym, NULL, + NULL, false)) + return false; return resolve_structure_cons (expr, 0); } m = gfc_intrinsic_func_interface (expr, 0); if (m == MATCH_YES) - return SUCCESS; + return true; if (m == MATCH_NO) gfc_error ("Generic function '%s' at %L is not consistent with a " "specific intrinsic interface", expr->symtree->n.sym->name, &expr->where); - return FAILURE; + return false; } @@ -2536,7 +2533,7 @@ found: } -static gfc_try +static bool resolve_specific_f (gfc_expr *expr) { gfc_symbol *sym; @@ -2548,9 +2545,9 @@ resolve_specific_f (gfc_expr *expr) { m = resolve_specific_f0 (sym, expr); if (m == MATCH_YES) - return SUCCESS; + return true; if (m == MATCH_ERROR) - return FAILURE; + return false; if (sym->ns->parent == NULL) break; @@ -2564,13 +2561,13 @@ resolve_specific_f (gfc_expr *expr) gfc_error ("Unable to resolve the specific function '%s' at %L", expr->symtree->n.sym->name, &expr->where); - return SUCCESS; + return true; } /* Resolve a procedure call not known to be generic nor specific. */ -static gfc_try +static bool resolve_unknown_f (gfc_expr *expr) { gfc_symbol *sym; @@ -2590,8 +2587,8 @@ resolve_unknown_f (gfc_expr *expr) if (gfc_is_intrinsic (sym, 0, expr->where)) { if (gfc_intrinsic_func_interface (expr, 1) == MATCH_YES) - return SUCCESS; - return FAILURE; + return true; + return false; } /* The reference is to an external name. */ @@ -2619,13 +2616,13 @@ set_type: { gfc_error ("Function '%s' at %L has no IMPLICIT type", sym->name, &expr->where); - return FAILURE; + return false; } else expr->ts = *ts; } - return SUCCESS; + return true; } @@ -2713,13 +2710,13 @@ pure_stmt_function (gfc_expr *e, gfc_symbol *sym) /* Resolve a function call, which means resolving the arguments, then figuring out which entity the name refers to. */ -static gfc_try +static bool resolve_function (gfc_expr *expr) { gfc_actual_arglist *arg; gfc_symbol *sym; const char *name; - gfc_try t; + bool t; int temp; procedure_type p = PROC_INTRINSIC; bool no_formal_args; @@ -2730,16 +2727,16 @@ resolve_function (gfc_expr *expr) /* If this is a procedure pointer component, it has already been resolved. */ if (gfc_is_proc_ptr_comp (expr)) - return SUCCESS; + return true; if (sym && sym->attr.intrinsic - && gfc_resolve_intrinsic (sym, &expr->where) == FAILURE) - return FAILURE; + && !gfc_resolve_intrinsic (sym, &expr->where)) + return false; if (sym && (sym->attr.flavor == FL_VARIABLE || sym->attr.subroutine)) { gfc_error ("'%s' at %L is not a function", sym->name, &expr->where); - return FAILURE; + return false; } /* If this ia a deferred TBP with an abstract interface (which may @@ -2748,7 +2745,7 @@ resolve_function (gfc_expr *expr) { gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L", sym->name, &expr->where); - return FAILURE; + return false; } /* Switch off assumed size checking and do this again for certain kinds @@ -2763,11 +2760,11 @@ resolve_function (gfc_expr *expr) no_formal_args = sym && is_external_proc (sym) && gfc_sym_get_dummy_args (sym) == NULL; - if (resolve_actual_arglist (expr->value.function.actual, - p, no_formal_args) == FAILURE) + if (!resolve_actual_arglist (expr->value.function.actual, + p, no_formal_args)) { inquiry_argument = false; - return FAILURE; + return false; } inquiry_argument = false; @@ -2792,7 +2789,7 @@ resolve_function (gfc_expr *expr) gfc_error ("Function '%s' is declared CHARACTER(*) and cannot " "be used at %L since it is not a dummy argument", sym->name, &expr->where); - return FAILURE; + return false; } /* See if function is already resolved. */ @@ -2801,7 +2798,7 @@ resolve_function (gfc_expr *expr) { if (expr->ts.type == BT_UNKNOWN) expr->ts = sym->ts; - t = SUCCESS; + t = true; } else { @@ -2835,8 +2832,8 @@ resolve_function (gfc_expr *expr) temp = need_full_assumed_size; need_full_assumed_size = 0; - if (resolve_elemental_actual (expr, NULL) == FAILURE) - return FAILURE; + if (!resolve_elemental_actual (expr, NULL)) + return false; if (omp_workshare_flag && expr->value.function.esym @@ -2845,7 +2842,7 @@ resolve_function (gfc_expr *expr) gfc_error ("User defined non-ELEMENTAL function '%s' at %L not allowed " "in WORKSHARE construct", expr->value.function.esym->name, &expr->where); - t = FAILURE; + t = false; } #define GENERIC_ID expr->value.function.isym->id @@ -2870,7 +2867,7 @@ resolve_function (gfc_expr *expr) if (arg->next->expr->expr_type != EXPR_CONSTANT) break; - if (arg->next->name && strncmp(arg->next->name, "kind", 4) == 0) + if (arg->next->name && strncmp (arg->next->name, "kind", 4) == 0) break; if ((int)mpz_get_si (arg->next->expr->value.integer) @@ -2881,7 +2878,7 @@ resolve_function (gfc_expr *expr) if (arg->expr != NULL && arg->expr->rank > 0 && resolve_assumed_size_actual (arg->expr)) - return FAILURE; + return false; } } #undef GENERIC_ID @@ -2896,20 +2893,20 @@ resolve_function (gfc_expr *expr) gfc_error ("Reference to non-PURE function '%s' at %L inside a " "FORALL %s", name, &expr->where, forall_flag == 2 ? "mask" : "block"); - t = FAILURE; + t = false; } else if (do_concurrent_flag) { gfc_error ("Reference to non-PURE function '%s' at %L inside a " "DO CONCURRENT %s", name, &expr->where, do_concurrent_flag == 2 ? "mask" : "block"); - t = FAILURE; + t = false; } else if (gfc_pure (NULL)) { gfc_error ("Function reference to '%s' at %L is to a non-PURE " "procedure within a PURE procedure", name, &expr->where); - t = FAILURE; + t = false; } if (gfc_implicit_pure (NULL)) @@ -2933,7 +2930,7 @@ resolve_function (gfc_expr *expr) gfc_error ("Function '%s' at %L cannot be called recursively, as it" " is not RECURSIVE", esym->name, &expr->where); - t = FAILURE; + t = false; } } @@ -3008,7 +3005,7 @@ resolve_generic_s0 (gfc_code *c, gfc_symbol *sym) } -static gfc_try +static bool resolve_generic_s (gfc_code *c) { gfc_symbol *sym; @@ -3020,9 +3017,9 @@ resolve_generic_s (gfc_code *c) { m = resolve_generic_s0 (c, sym); if (m == MATCH_YES) - return SUCCESS; + return true; else if (m == MATCH_ERROR) - return FAILURE; + return false; generic: if (sym->ns->parent == NULL) @@ -3043,17 +3040,17 @@ generic: { gfc_error ("There is no specific subroutine for the generic '%s' at %L", sym->name, &c->loc); - return FAILURE; + return false; } m = gfc_intrinsic_sub_interface (c, 0); if (m == MATCH_YES) - return SUCCESS; + return true; if (m == MATCH_NO) gfc_error ("Generic subroutine '%s' at %L is not consistent with an " "intrinsic subroutine interface", sym->name, &c->loc); - return FAILURE; + return false; } @@ -3103,7 +3100,7 @@ found: } -static gfc_try +static bool resolve_specific_s (gfc_code *c) { gfc_symbol *sym; @@ -3115,9 +3112,9 @@ resolve_specific_s (gfc_code *c) { m = resolve_specific_s0 (c, sym); if (m == MATCH_YES) - return SUCCESS; + return true; if (m == MATCH_ERROR) - return FAILURE; + return false; if (sym->ns->parent == NULL) break; @@ -3132,13 +3129,13 @@ resolve_specific_s (gfc_code *c) gfc_error ("Unable to resolve the specific subroutine '%s' at %L", sym->name, &c->loc); - return FAILURE; + return false; } /* Resolve a subroutine call not known to be generic nor specific. */ -static gfc_try +static bool resolve_unknown_s (gfc_code *c) { gfc_symbol *sym; @@ -3156,8 +3153,8 @@ resolve_unknown_s (gfc_code *c) if (gfc_is_intrinsic (sym, 1, c->loc)) { if (gfc_intrinsic_sub_interface (c, 1) == MATCH_YES) - return SUCCESS; - return FAILURE; + return true; + return false; } /* The reference is to an external name. */ @@ -3169,7 +3166,7 @@ found: pure_subroutine (c, sym); - return SUCCESS; + return true; } @@ -3177,10 +3174,10 @@ found: for functions, subroutines and functions are stored differently and this makes things awkward. */ -static gfc_try +static bool resolve_call (gfc_code *c) { - gfc_try t; + bool t; procedure_type ptype = PROC_INTRINSIC; gfc_symbol *csym, *sym; bool no_formal_args; @@ -3191,7 +3188,7 @@ resolve_call (gfc_code *c) { gfc_error ("'%s' at %L has a type, which is not consistent with " "the CALL at %L", csym->name, &csym->declared_at, &c->loc); - return FAILURE; + return false; } if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns) @@ -3220,7 +3217,7 @@ resolve_call (gfc_code *c) { gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L", csym->name, &c->loc); - return FAILURE; + return false; } /* Subroutines without the RECURSIVE attribution are not allowed to @@ -3235,7 +3232,7 @@ resolve_call (gfc_code *c) gfc_error ("SUBROUTINE '%s' at %L cannot be called recursively, " "as it is not RECURSIVE", csym->name, &c->loc); - t = FAILURE; + t = false; } } @@ -3248,9 +3245,8 @@ resolve_call (gfc_code *c) no_formal_args = csym && is_external_proc (csym) && gfc_sym_get_dummy_args (csym) == NULL; - if (resolve_actual_arglist (c->ext.actual, ptype, - no_formal_args) == FAILURE) - return FAILURE; + if (!resolve_actual_arglist (c->ext.actual, ptype, no_formal_args)) + return false; /* Resume assumed_size checking. */ need_full_assumed_size--; @@ -3259,7 +3255,7 @@ resolve_call (gfc_code *c) if (csym && is_external_proc (csym)) resolve_global_procedure (csym, &c->loc, &c->ext.actual, 1); - t = SUCCESS; + t = true; if (c->resolved_sym == NULL) { c->resolved_isym = NULL; @@ -3283,26 +3279,26 @@ resolve_call (gfc_code *c) } /* Some checks of elemental subroutine actual arguments. */ - if (resolve_elemental_actual (NULL, c) == FAILURE) - return FAILURE; + if (!resolve_elemental_actual (NULL, c)) + return false; return t; } /* Compare the shapes of two arrays that have non-NULL shapes. If both - op1->shape and op2->shape are non-NULL return SUCCESS if their shapes - match. If both op1->shape and op2->shape are non-NULL return FAILURE + op1->shape and op2->shape are non-NULL return true if their shapes + match. If both op1->shape and op2->shape are non-NULL return false if their shapes do not match. If either op1->shape or op2->shape is - NULL, return SUCCESS. */ + NULL, return true. */ -static gfc_try +static bool compare_shapes (gfc_expr *op1, gfc_expr *op2) { - gfc_try t; + bool t; int i; - t = SUCCESS; + t = true; if (op1->shape != NULL && op2->shape != NULL) { @@ -3312,7 +3308,7 @@ compare_shapes (gfc_expr *op1, gfc_expr *op2) { gfc_error ("Shapes for operands at %L and %L are not conformable", &op1->where, &op2->where); - t = FAILURE; + t = false; break; } } @@ -3325,21 +3321,21 @@ compare_shapes (gfc_expr *op1, gfc_expr *op2) /* Resolve an operator expression node. This can involve replacing the operation with a user defined function call. */ -static gfc_try +static bool resolve_operator (gfc_expr *e) { gfc_expr *op1, *op2; char msg[200]; bool dual_locus_error; - gfc_try t; + bool t; /* Resolve all subnodes-- give them types. */ switch (e->value.op.op) { default: - if (gfc_resolve_expr (e->value.op.op2) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (e->value.op.op2)) + return false; /* Fall through... */ @@ -3347,8 +3343,8 @@ resolve_operator (gfc_expr *e) case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: case INTRINSIC_PARENTHESES: - if (gfc_resolve_expr (e->value.op.op1) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (e->value.op.op1)) + return false; break; } @@ -3546,7 +3542,7 @@ resolve_operator (gfc_expr *e) /* Deal with arrayness of an operand through an operator. */ - t = SUCCESS; + t = true; switch (e->value.op.op) { @@ -3600,7 +3596,7 @@ resolve_operator (gfc_expr *e) if (e->shape == NULL) { t = compare_shapes (op1, op2); - if (t == FAILURE) + if (!t) e->shape = NULL; else e->shape = gfc_copy_shape (op1->shape, op1->rank); @@ -3638,14 +3634,14 @@ resolve_operator (gfc_expr *e) } /* Attempt to simplify the expression. */ - if (t == SUCCESS) + if (t) { t = gfc_simplify_expr (e, 0); - /* Some calls do not succeed in simplification and return FAILURE + /* Some calls do not succeed in simplification and return false even though there is no error; e.g. variable references to PARAMETER arrays. */ if (!gfc_is_constant_expr (e)) - t = SUCCESS; + t = true; } return t; @@ -3654,9 +3650,9 @@ bad_op: { match m = gfc_extend_expr (e); if (m == MATCH_YES) - return SUCCESS; + return true; if (m == MATCH_ERROR) - return FAILURE; + return false; } if (dual_locus_error) @@ -3664,7 +3660,7 @@ bad_op: else gfc_error (msg, &e->where); - return FAILURE; + return false; } @@ -3766,7 +3762,7 @@ compute_last_value_for_triplet (gfc_expr *start, gfc_expr *end, || (stride != NULL && stride->ts.type != BT_INTEGER)) return 0; - if (stride == NULL || compare_bound_int(stride, 1) == CMP_EQ) + if (stride == NULL || compare_bound_int (stride, 1) == CMP_EQ) { if (compare_bound (start, end) == CMP_GT) return 0; @@ -3800,7 +3796,7 @@ compute_last_value_for_triplet (gfc_expr *start, gfc_expr *end, /* Compare a single dimension of an array reference to the array specification. */ -static gfc_try +static bool check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) { mpz_t last_value; @@ -3812,7 +3808,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) if (ar->start[i] == NULL) { gcc_assert (ar->end[i] == NULL); - return SUCCESS; + return true; } } @@ -3840,7 +3836,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) mpz_get_si (ar->start[i]->value.integer), mpz_get_si (as->lower[i]->value.integer), i + 1 - as->rank); - return SUCCESS; + return true; } if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT) { @@ -3855,7 +3851,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) mpz_get_si (ar->start[i]->value.integer), mpz_get_si (as->upper[i]->value.integer), i + 1 - as->rank); - return SUCCESS; + return true; } break; @@ -3871,7 +3867,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) if (compare_bound_int (ar->stride[i], 0) == CMP_EQ) { gfc_error ("Illegal stride of zero at %L", &ar->c_where[i]); - return FAILURE; + return false; } /* if start == len || (stride > 0 && start < len) @@ -3891,7 +3887,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) "(%ld < %ld) in dimension %d", &ar->c_where[i], mpz_get_si (AR_START->value.integer), mpz_get_si (as->lower[i]->value.integer), i+1); - return SUCCESS; + return true; } if (compare_bound (AR_START, as->upper[i]) == CMP_GT) { @@ -3899,7 +3895,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) "(%ld > %ld) in dimension %d", &ar->c_where[i], mpz_get_si (AR_START->value.integer), mpz_get_si (as->upper[i]->value.integer), i+1); - return SUCCESS; + return true; } } @@ -3916,7 +3912,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) mpz_get_si (last_value), mpz_get_si (as->lower[i]->value.integer), i+1); mpz_clear (last_value); - return SUCCESS; + return true; } if (compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT) { @@ -3925,7 +3921,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) mpz_get_si (last_value), mpz_get_si (as->upper[i]->value.integer), i+1); mpz_clear (last_value); - return SUCCESS; + return true; } } mpz_clear (last_value); @@ -3939,13 +3935,13 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) gfc_internal_error ("check_dimension(): Bad array reference"); } - return SUCCESS; + return true; } /* Compare an array reference with an array specification. */ -static gfc_try +static bool compare_spec_to_ref (gfc_array_ref *ar) { gfc_array_spec *as; @@ -3961,17 +3957,17 @@ compare_spec_to_ref (gfc_array_ref *ar) { gfc_error ("Rightmost upper bound of assumed size array section " "not specified at %L", &ar->where); - return FAILURE; + return false; } if (ar->type == AR_FULL) - return SUCCESS; + return true; if (as->rank != ar->dimen) { gfc_error ("Rank mismatch in array reference at %L (%d/%d)", &ar->where, ar->dimen, as->rank); - return FAILURE; + return false; } /* ar->codimen == 0 is a local array. */ @@ -3979,12 +3975,12 @@ compare_spec_to_ref (gfc_array_ref *ar) { gfc_error ("Coindex rank mismatch in array reference at %L (%d/%d)", &ar->where, ar->codimen, as->corank); - return FAILURE; + return false; } for (i = 0; i < as->rank; i++) - if (check_dimension (i, ar, as) == FAILURE) - return FAILURE; + if (!check_dimension (i, ar, as)) + return false; /* Local access has no coarray spec. */ if (ar->codimen != 0) @@ -3995,47 +3991,47 @@ compare_spec_to_ref (gfc_array_ref *ar) { gfc_error ("Coindex of codimension %d must be a scalar at %L", i + 1 - as->rank, &ar->where); - return FAILURE; + return false; } - if (check_dimension (i, ar, as) == FAILURE) - return FAILURE; + if (!check_dimension (i, ar, as)) + return false; } - return SUCCESS; + return true; } /* Resolve one part of an array index. */ -static gfc_try +static bool gfc_resolve_index_1 (gfc_expr *index, int check_scalar, int force_index_integer_kind) { gfc_typespec ts; if (index == NULL) - return SUCCESS; + return true; - if (gfc_resolve_expr (index) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (index)) + return false; if (check_scalar && index->rank != 0) { gfc_error ("Array index at %L must be scalar", &index->where); - return FAILURE; + return false; } if (index->ts.type != BT_INTEGER && index->ts.type != BT_REAL) { gfc_error ("Array index at %L must be of INTEGER type, found %s", &index->where, gfc_basic_typename (index->ts.type)); - return FAILURE; + return false; } if (index->ts.type == BT_REAL) - if (gfc_notify_std (GFC_STD_LEGACY, "REAL array index at %L", - &index->where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, "REAL array index at %L", + &index->where)) + return false; if ((index->ts.kind != gfc_index_integer_kind && force_index_integer_kind) @@ -4048,12 +4044,12 @@ gfc_resolve_index_1 (gfc_expr *index, int check_scalar, gfc_convert_type_warn (index, &ts, 2, 0); } - return SUCCESS; + return true; } /* Resolve one part of an array index. */ -gfc_try +bool gfc_resolve_index (gfc_expr *index, int check_scalar) { return gfc_resolve_index_1 (index, check_scalar, 1); @@ -4061,26 +4057,26 @@ gfc_resolve_index (gfc_expr *index, int check_scalar) /* Resolve a dim argument to an intrinsic function. */ -gfc_try +bool gfc_resolve_dim_arg (gfc_expr *dim) { if (dim == NULL) - return SUCCESS; + return true; - if (gfc_resolve_expr (dim) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (dim)) + return false; if (dim->rank != 0) { gfc_error ("Argument dim at %L must be scalar", &dim->where); - return FAILURE; + return false; } if (dim->ts.type != BT_INTEGER) { gfc_error ("Argument dim at %L must be of INTEGER type", &dim->where); - return FAILURE; + return false; } if (dim->ts.kind != gfc_index_integer_kind) @@ -4094,7 +4090,7 @@ gfc_resolve_dim_arg (gfc_expr *dim) gfc_convert_type_warn (dim, &ts, 2, 0); } - return SUCCESS; + return true; } /* Given an expression that contains array references, update those array @@ -4152,7 +4148,7 @@ find_array_spec (gfc_expr *e) /* Resolve an array reference. */ -static gfc_try +static bool resolve_array_ref (gfc_array_ref *ar) { int i, check_scalar; @@ -4165,12 +4161,12 @@ resolve_array_ref (gfc_array_ref *ar) /* Do not force gfc_index_integer_kind for the start. We can do fine with any integer kind. This avoids temporary arrays created for indexing with a vector. */ - if (gfc_resolve_index_1 (ar->start[i], check_scalar, 0) == FAILURE) - return FAILURE; - if (gfc_resolve_index (ar->end[i], check_scalar) == FAILURE) - return FAILURE; - if (gfc_resolve_index (ar->stride[i], check_scalar) == FAILURE) - return FAILURE; + if (!gfc_resolve_index_1 (ar->start[i], check_scalar, 0)) + return false; + if (!gfc_resolve_index (ar->end[i], check_scalar)) + return false; + if (!gfc_resolve_index (ar->stride[i], check_scalar)) + return false; e = ar->start[i]; @@ -4191,7 +4187,7 @@ resolve_array_ref (gfc_array_ref *ar) default: gfc_error ("Array index at %L is an array of rank %d", &ar->c_where[i], e->rank); - return FAILURE; + return false; } /* Fill in the upper bound, which may be lower than the @@ -4205,7 +4201,7 @@ resolve_array_ref (gfc_array_ref *ar) { mpz_t size, end; - if (gfc_ref_dimen_size (ar, i, &size, &end) == SUCCESS) + if (gfc_ref_dimen_size (ar, i, &size, &end)) { if (ar->end[i] == NULL) { @@ -4260,8 +4256,8 @@ resolve_array_ref (gfc_array_ref *ar) } } - if (!ar->as->cray_pointee && compare_spec_to_ref (ar) == FAILURE) - return FAILURE; + if (!ar->as->cray_pointee && !compare_spec_to_ref (ar)) + return false; if (ar->as->corank && ar->codimen == 0) { @@ -4271,32 +4267,32 @@ resolve_array_ref (gfc_array_ref *ar) ar->dimen_type[n] = DIMEN_THIS_IMAGE; } - return SUCCESS; + return true; } -static gfc_try +static bool resolve_substring (gfc_ref *ref) { int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false); if (ref->u.ss.start != NULL) { - if (gfc_resolve_expr (ref->u.ss.start) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (ref->u.ss.start)) + return false; if (ref->u.ss.start->ts.type != BT_INTEGER) { gfc_error ("Substring start index at %L must be of type INTEGER", &ref->u.ss.start->where); - return FAILURE; + return false; } if (ref->u.ss.start->rank != 0) { gfc_error ("Substring start index at %L must be scalar", &ref->u.ss.start->where); - return FAILURE; + return false; } if (compare_bound_int (ref->u.ss.start, 1) == CMP_LT @@ -4305,27 +4301,27 @@ resolve_substring (gfc_ref *ref) { gfc_error ("Substring start index at %L is less than one", &ref->u.ss.start->where); - return FAILURE; + return false; } } if (ref->u.ss.end != NULL) { - if (gfc_resolve_expr (ref->u.ss.end) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (ref->u.ss.end)) + return false; if (ref->u.ss.end->ts.type != BT_INTEGER) { gfc_error ("Substring end index at %L must be of type INTEGER", &ref->u.ss.end->where); - return FAILURE; + return false; } if (ref->u.ss.end->rank != 0) { gfc_error ("Substring end index at %L must be scalar", &ref->u.ss.end->where); - return FAILURE; + return false; } if (ref->u.ss.length != NULL @@ -4335,7 +4331,7 @@ resolve_substring (gfc_ref *ref) { gfc_error ("Substring end index at %L exceeds the string length", &ref->u.ss.start->where); - return FAILURE; + return false; } if (compare_bound_mpz_t (ref->u.ss.end, @@ -4345,11 +4341,11 @@ resolve_substring (gfc_ref *ref) { gfc_error ("Substring end index at %L is too large", &ref->u.ss.end->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } @@ -4421,7 +4417,7 @@ gfc_resolve_substring_charlen (gfc_expr *e) /* Resolve subtype references. */ -static gfc_try +static bool resolve_ref (gfc_expr *expr) { int current_part_dimension, n_components, seen_part_dimension; @@ -4438,16 +4434,16 @@ resolve_ref (gfc_expr *expr) switch (ref->type) { case REF_ARRAY: - if (resolve_array_ref (&ref->u.ar) == FAILURE) - return FAILURE; + if (!resolve_array_ref (&ref->u.ar)) + return false; break; case REF_COMPONENT: break; case REF_SUBSTRING: - if (resolve_substring (ref) == FAILURE) - return FAILURE; + if (!resolve_substring (ref)) + return false; break; } @@ -4498,7 +4494,7 @@ resolve_ref (gfc_expr *expr) gfc_error ("Component to the right of a part reference " "with nonzero rank must not have the POINTER " "attribute at %L", &expr->where); - return FAILURE; + return false; } else if (ref->u.c.component->attr.allocatable || (ref->u.c.component->ts.type == BT_CLASS @@ -4508,7 +4504,7 @@ resolve_ref (gfc_expr *expr) gfc_error ("Component to the right of a part reference " "with nonzero rank must not have the ALLOCATABLE " "attribute at %L", &expr->where); - return FAILURE; + return false; } } @@ -4526,7 +4522,7 @@ resolve_ref (gfc_expr *expr) { gfc_error ("Two or more part references with nonzero rank must " "not be specified at %L", &expr->where); - return FAILURE; + return false; } if (ref->type == REF_COMPONENT) @@ -4539,7 +4535,7 @@ resolve_ref (gfc_expr *expr) } } - return SUCCESS; + return true; } @@ -4556,7 +4552,7 @@ expression_shape (gfc_expr *e) return; for (i = 0; i < e->rank; i++) - if (gfc_array_dimen_size (e, i, &array[i]) == FAILURE) + if (!gfc_array_dimen_size (e, i, &array[i])) goto fail; e->shape = gfc_get_shape (e->rank); @@ -4642,16 +4638,16 @@ done: /* Resolve a variable expression. */ -static gfc_try +static bool resolve_variable (gfc_expr *e) { gfc_symbol *sym; - gfc_try t; + bool t; - t = SUCCESS; + t = true; if (e->symtree == NULL) - return FAILURE; + return false; sym = e->symtree->n.sym; /* TS 29113, 407b. */ @@ -4661,7 +4657,7 @@ resolve_variable (gfc_expr *e) { gfc_error ("Assumed-type variable %s at %L may only be used " "as actual argument", sym->name, &e->where); - return FAILURE; + return false; } else if (inquiry_argument && !first_actual_arg) { @@ -4672,7 +4668,7 @@ resolve_variable (gfc_expr *e) gfc_error ("Assumed-type variable %s at %L as actual argument to " "an inquiry function shall be the first argument", sym->name, &e->where); - return FAILURE; + return false; } } @@ -4687,7 +4683,7 @@ resolve_variable (gfc_expr *e) { gfc_error ("Assumed-rank variable %s at %L may only be used as " "actual argument", sym->name, &e->where); - return FAILURE; + return false; } else if (inquiry_argument && !first_actual_arg) { @@ -4698,7 +4694,7 @@ resolve_variable (gfc_expr *e) gfc_error ("Assumed-rank variable %s at %L as actual argument " "to an inquiry function shall be the first argument", sym->name, &e->where); - return FAILURE; + return false; } } @@ -4709,7 +4705,7 @@ resolve_variable (gfc_expr *e) { gfc_error ("Assumed-type variable %s at %L shall not have a subobject " "reference", sym->name, &e->ref->u.ar.where); - return FAILURE; + return false; } /* TS 29113, C535b. */ @@ -4724,7 +4720,7 @@ resolve_variable (gfc_expr *e) { gfc_error ("Assumed-rank variable %s at %L shall not have a subobject " "reference", sym->name, &e->ref->u.ar.where); - return FAILURE; + return false; } @@ -4736,7 +4732,7 @@ resolve_variable (gfc_expr *e) if (sym->ts.type == BT_CLASS) gfc_fix_class_refs (e); if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY) - return FAILURE; + return false; } if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.generic) @@ -4752,8 +4748,8 @@ resolve_variable (gfc_expr *e) e->ref->u.ar.dimen = 0; } - if (e->ref && resolve_ref (e) == FAILURE) - return FAILURE; + if (e->ref && !resolve_ref (e)) + return false; if (sym->attr.flavor == FL_PROCEDURE && (!sym->attr.function @@ -4770,13 +4766,13 @@ resolve_variable (gfc_expr *e) else { /* Must be a simple variable reference. */ - if (gfc_set_default_type (sym, 1, sym->ns) == FAILURE) - return FAILURE; + if (!gfc_set_default_type (sym, 1, sym->ns)) + return false; e->ts = sym->ts; } if (check_assumed_size_reference (sym, e)) - return FAILURE; + return false; /* Deal with forward references to entries during resolve_code, to satisfy, at least partially, 12.5.2.5. */ @@ -4817,7 +4813,7 @@ resolve_variable (gfc_expr *e) gfc_error ("Variable '%s' is used at %L before the ENTRY " "statement in which it is a parameter", sym->name, &cs_base->current->loc); - t = FAILURE; + t = false; } } @@ -4825,20 +4821,20 @@ resolve_variable (gfc_expr *e) saved_specification_expr = specification_expr; specification_expr = true; if (sym->ts.type == BT_CHARACTER - && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE) - t = FAILURE; + && !gfc_resolve_expr (sym->ts.u.cl->length)) + t = false; if (sym->as) for (n = 0; n < sym->as->rank; n++) { - if (gfc_resolve_expr (sym->as->lower[n]) == FAILURE) - t = FAILURE; - if (gfc_resolve_expr (sym->as->upper[n]) == FAILURE) - t = FAILURE; + if (!gfc_resolve_expr (sym->as->lower[n])) + t = false; + if (!gfc_resolve_expr (sym->as->upper[n])) + t = false; } specification_expr = saved_specification_expr; - if (t == SUCCESS) + if (t) /* Update the symbol's entry level. */ sym->entry_id = current_entry_id + 1; } @@ -4853,8 +4849,8 @@ resolve_variable (gfc_expr *e) sym->attr.host_assoc = 1; resolve_procedure: - if (t == SUCCESS && resolve_procedure_expression (e) == FAILURE) - t = FAILURE; + if (t && !resolve_procedure_expression (e)) + t = false; /* F2008, C617 and C1229. */ if (!inquiry_argument && (e->ts.type == BT_CLASS || e->ts.type == BT_DERIVED) @@ -4879,7 +4875,7 @@ resolve_procedure: { gfc_error ("Polymorphic subobject of coindexed object at %L", &e->where); - t = FAILURE; + t = false; } /* Expression itself is coindexed object. */ @@ -4892,7 +4888,7 @@ resolve_procedure: { gfc_error ("Coindexed object with polymorphic allocatable " "subcomponent at %L", &e->where); - t = FAILURE; + t = false; break; } } @@ -5126,7 +5122,7 @@ extract_compcall_passed_object (gfc_expr* e) po->where = e->where; } - if (gfc_resolve_expr (po) == FAILURE) + if (!gfc_resolve_expr (po)) return NULL; return po; @@ -5136,7 +5132,7 @@ extract_compcall_passed_object (gfc_expr* e) /* Update the arglist of an EXPR_COMPCALL expression to include the passed-object. */ -static gfc_try +static bool update_compcall_arglist (gfc_expr* e) { gfc_expr* po; @@ -5145,16 +5141,16 @@ update_compcall_arglist (gfc_expr* e) tbp = e->value.compcall.tbp; if (tbp->error) - return FAILURE; + return false; po = extract_compcall_passed_object (e); if (!po) - return FAILURE; + return false; if (tbp->nopass || e->value.compcall.ignore_pass) { gfc_free_expr (po); - return SUCCESS; + return true; } gcc_assert (tbp->pass_arg_num > 0); @@ -5162,7 +5158,7 @@ update_compcall_arglist (gfc_expr* e) tbp->pass_arg_num, tbp->pass_arg); - return SUCCESS; + return true; } @@ -5187,7 +5183,7 @@ extract_ppc_passed_object (gfc_expr *e) gfc_free_ref_list (*ref); *ref = NULL; - if (gfc_resolve_expr (po) == FAILURE) + if (!gfc_resolve_expr (po)) return NULL; return po; @@ -5197,7 +5193,7 @@ extract_ppc_passed_object (gfc_expr *e) /* Update the actual arglist of a procedure pointer component to include the passed-object. */ -static gfc_try +static bool update_ppc_arglist (gfc_expr* e) { gfc_expr* po; @@ -5206,24 +5202,24 @@ update_ppc_arglist (gfc_expr* e) ppc = gfc_get_proc_ptr_comp (e); if (!ppc) - return FAILURE; + return false; tb = ppc->tb; if (tb->error) - return FAILURE; + return false; else if (tb->nopass) - return SUCCESS; + return true; po = extract_ppc_passed_object (e); if (!po) - return FAILURE; + return false; /* F08:R739. */ if (po->rank != 0) { gfc_error ("Passed-object at %L must be scalar", &e->where); - return FAILURE; + return false; } /* F08:C611. */ @@ -5231,7 +5227,7 @@ update_ppc_arglist (gfc_expr* e) { gfc_error ("Base object for procedure-pointer component call at %L is of" " ABSTRACT type '%s'", &e->where, po->ts.u.derived->name); - return FAILURE; + return false; } gcc_assert (tb->pass_arg_num > 0); @@ -5239,27 +5235,27 @@ update_ppc_arglist (gfc_expr* e) tb->pass_arg_num, tb->pass_arg); - return SUCCESS; + return true; } /* Check that the object a TBP is called on is valid, i.e. it must not be of ABSTRACT type (as in subobject%abstract_parent%tbp()). */ -static gfc_try +static bool check_typebound_baseobject (gfc_expr* e) { gfc_expr* base; - gfc_try return_value = FAILURE; + bool return_value = false; base = extract_compcall_passed_object (e); if (!base) - return FAILURE; + return false; gcc_assert (base->ts.type == BT_DERIVED || base->ts.type == BT_CLASS); if (base->ts.type == BT_CLASS && !gfc_expr_attr (base).class_ok) - return FAILURE; + return false; /* F08:C611. */ if (base->ts.type == BT_DERIVED && base->ts.u.derived->attr.abstract) @@ -5278,7 +5274,7 @@ check_typebound_baseobject (gfc_expr* e) goto cleanup; } - return_value = SUCCESS; + return_value = true; cleanup: gfc_free_expr (base); @@ -5290,7 +5286,7 @@ cleanup: statically from the data in an EXPR_COMPCALL expression. The adapted arglist and the target-procedure symtree are returned. */ -static gfc_try +static bool resolve_typebound_static (gfc_expr* e, gfc_symtree** target, gfc_actual_arglist** actual) { @@ -5298,8 +5294,8 @@ resolve_typebound_static (gfc_expr* e, gfc_symtree** target, gcc_assert (!e->value.compcall.tbp->is_generic); /* Update the actual arglist for PASS. */ - if (update_compcall_arglist (e) == FAILURE) - return FAILURE; + if (!update_compcall_arglist (e)) + return false; *actual = e->value.compcall.actual; *target = e->value.compcall.tbp->u.specific; @@ -5340,7 +5336,7 @@ resolve_typebound_static (gfc_expr* e, gfc_symtree** target, if (st) *target = st; } - return SUCCESS; + return true; } @@ -5387,7 +5383,7 @@ get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref, which of the specific bindings (if any) matches the arglist and transform the expression into a call of that binding. */ -static gfc_try +static bool resolve_typebound_generic_call (gfc_expr* e, const char **name) { gfc_typebound_proc* genproc; @@ -5400,7 +5396,7 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name) genproc = e->value.compcall.tbp; if (!genproc->is_generic) - return SUCCESS; + return true; /* Try the bindings on this type and in the inheritance hierarchy. */ for (; genproc; genproc = genproc->overridden) @@ -5430,7 +5426,7 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name) if (!po) { gfc_free_actual_arglist (args); - return FAILURE; + return false; } gcc_assert (g->specific->pass_arg_num > 0); @@ -5463,7 +5459,7 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name) /* Nothing matching found! */ gfc_error ("Found no matching specific binding for the call to the GENERIC" " '%s' at %L", genname, &e->where); - return FAILURE; + return false; success: /* Make sure that we have the right specific instance for the name. */ @@ -5473,13 +5469,13 @@ success: if (st) e->value.compcall.tbp = st->n.tb; - return SUCCESS; + return true; } /* Resolve a call to a type-bound subroutine. */ -static gfc_try +static bool resolve_typebound_call (gfc_code* c, const char **name) { gfc_actual_arglist* newactual; @@ -5490,24 +5486,24 @@ resolve_typebound_call (gfc_code* c, const char **name) { gfc_error ("'%s' at %L should be a SUBROUTINE", c->expr1->value.compcall.name, &c->loc); - return FAILURE; + return false; } - if (check_typebound_baseobject (c->expr1) == FAILURE) - return FAILURE; + if (!check_typebound_baseobject (c->expr1)) + return false; /* Pass along the name for CLASS methods, where the vtab procedure pointer component has to be referenced. */ if (name) *name = c->expr1->value.compcall.name; - if (resolve_typebound_generic_call (c->expr1, name) == FAILURE) - return FAILURE; + if (!resolve_typebound_generic_call (c->expr1, name)) + return false; /* Transform into an ordinary EXEC_CALL for now. */ - if (resolve_typebound_static (c->expr1, &target, &newactual) == FAILURE) - return FAILURE; + if (!resolve_typebound_static (c->expr1, &target, &newactual)) + return false; c->ext.actual = newactual; c->symtree = target; @@ -5526,7 +5522,7 @@ resolve_typebound_call (gfc_code* c, const char **name) /* Resolve a component-call expression. */ -static gfc_try +static bool resolve_compcall (gfc_expr* e, const char **name) { gfc_actual_arglist* newactual; @@ -5537,22 +5533,22 @@ resolve_compcall (gfc_expr* e, const char **name) { gfc_error ("'%s' at %L should be a FUNCTION", e->value.compcall.name, &e->where); - return FAILURE; + return false; } /* These must not be assign-calls! */ gcc_assert (!e->value.compcall.assign); - if (check_typebound_baseobject (e) == FAILURE) - return FAILURE; + if (!check_typebound_baseobject (e)) + return false; /* Pass along the name for CLASS methods, where the vtab procedure pointer component has to be referenced. */ if (name) *name = e->value.compcall.name; - if (resolve_typebound_generic_call (e, name) == FAILURE) - return FAILURE; + if (!resolve_typebound_generic_call (e, name)) + return false; gcc_assert (!e->value.compcall.tbp->is_generic); /* Take the rank from the function's symbol. */ @@ -5562,8 +5558,8 @@ resolve_compcall (gfc_expr* e, const char **name) /* For now, we simply transform it into an EXPR_FUNCTION call with the same arglist to the TBP's binding target. */ - if (resolve_typebound_static (e, &target, &newactual) == FAILURE) - return FAILURE; + if (!resolve_typebound_static (e, &target, &newactual)) + return false; e->value.function.actual = newactual; e->value.function.name = NULL; @@ -5584,7 +5580,7 @@ resolve_compcall (gfc_expr* e, const char **name) /* Resolve a typebound function, or 'method'. First separate all the non-CLASS references by calling resolve_compcall directly. */ -static gfc_try +static bool resolve_typebound_function (gfc_expr* e) { gfc_symbol *declared; @@ -5628,8 +5624,8 @@ resolve_typebound_function (gfc_expr* e) if (c->ts.u.derived == NULL) c->ts.u.derived = gfc_find_derived_vtab (declared); - if (resolve_compcall (e, &name) == FAILURE) - return FAILURE; + if (!resolve_compcall (e, &name)) + return false; /* Use the generic name if it is there. */ name = name ? name : e->value.function.esym->name; @@ -5655,14 +5651,14 @@ resolve_typebound_function (gfc_expr* e) e->value.function.esym = NULL; if (expr->expr_type != EXPR_VARIABLE) e->base_expr = expr; - return SUCCESS; + return true; } if (st == NULL) return resolve_compcall (e, NULL); - if (resolve_ref (e) == FAILURE) - return FAILURE; + if (!resolve_ref (e)) + return false; /* Get the CLASS declared type. */ declared = get_declared_from_expr (&class_ref, &new_ref, e, true); @@ -5680,10 +5676,10 @@ resolve_typebound_function (gfc_expr* e) /* Treat the call as if it is a typebound procedure, in order to roll out the correct name for the specific function. */ - if (resolve_compcall (e, &name) == FAILURE) + if (!resolve_compcall (e, &name)) { gfc_free_ref_list (new_ref); - return FAILURE; + return false; } ts = e->ts; @@ -5707,14 +5703,14 @@ resolve_typebound_function (gfc_expr* e) e->ts = ts; } - return SUCCESS; + return true; } /* Resolve a typebound subroutine, or 'method'. First separate all the non-CLASS references by calling resolve_typebound_call directly. */ -static gfc_try +static bool resolve_typebound_subroutine (gfc_code *code) { gfc_symbol *declared; @@ -5756,8 +5752,8 @@ resolve_typebound_subroutine (gfc_code *code) if (c->ts.u.derived == NULL) c->ts.u.derived = gfc_find_derived_vtab (declared); - if (resolve_typebound_call (code, &name) == FAILURE) - return FAILURE; + if (!resolve_typebound_call (code, &name)) + return false; /* Use the generic name if it is there. */ name = name ? name : code->expr1->value.function.esym->name; @@ -5784,14 +5780,14 @@ resolve_typebound_subroutine (gfc_code *code) code->expr1->value.function.esym = NULL; if (expr->expr_type != EXPR_VARIABLE) code->expr1->base_expr = expr; - return SUCCESS; + return true; } if (st == NULL) return resolve_typebound_call (code, NULL); - if (resolve_ref (code->expr1) == FAILURE) - return FAILURE; + if (!resolve_ref (code->expr1)) + return false; /* Get the CLASS declared type. */ get_declared_from_expr (&class_ref, &new_ref, code->expr1, true); @@ -5804,10 +5800,10 @@ resolve_typebound_subroutine (gfc_code *code) return resolve_typebound_call (code, NULL); } - if (resolve_typebound_call (code, &name) == FAILURE) + if (!resolve_typebound_call (code, &name)) { gfc_free_ref_list (new_ref); - return FAILURE; + return false; } ts = code->expr1->ts; @@ -5831,13 +5827,13 @@ resolve_typebound_subroutine (gfc_code *code) code->expr1->ts = ts; } - return SUCCESS; + return true; } /* Resolve a CALL to a Procedure Pointer Component (Subroutine). */ -static gfc_try +static bool resolve_ppc_call (gfc_code* c) { gfc_component *comp; @@ -5851,27 +5847,28 @@ resolve_ppc_call (gfc_code* c) if (!comp->attr.subroutine) gfc_add_subroutine (&comp->attr, comp->name, &c->expr1->where); - if (resolve_ref (c->expr1) == FAILURE) - return FAILURE; + if (!resolve_ref (c->expr1)) + return false; - if (update_ppc_arglist (c->expr1) == FAILURE) - return FAILURE; + if (!update_ppc_arglist (c->expr1)) + return false; c->ext.actual = c->expr1->value.compcall.actual; - if (resolve_actual_arglist (c->ext.actual, comp->attr.proc, - !(comp->ts.interface && comp->ts.interface->formal)) == FAILURE) - return FAILURE; + if (!resolve_actual_arglist (c->ext.actual, comp->attr.proc, + !(comp->ts.interface + && comp->ts.interface->formal))) + return false; gfc_ppc_use (comp, &c->expr1->value.compcall.actual, &c->expr1->where); - return SUCCESS; + return true; } /* Resolve a Function Call to a Procedure Pointer Component (Function). */ -static gfc_try +static bool resolve_expr_ppc (gfc_expr* e) { gfc_component *comp; @@ -5890,19 +5887,20 @@ resolve_expr_ppc (gfc_expr* e) if (!comp->attr.function) gfc_add_function (&comp->attr, comp->name, &e->where); - if (resolve_ref (e) == FAILURE) - return FAILURE; + if (!resolve_ref (e)) + return false; - if (resolve_actual_arglist (e->value.function.actual, comp->attr.proc, - !(comp->ts.interface && comp->ts.interface->formal)) == FAILURE) - return FAILURE; + if (!resolve_actual_arglist (e->value.function.actual, comp->attr.proc, + !(comp->ts.interface + && comp->ts.interface->formal))) + return false; - if (update_ppc_arglist (e) == FAILURE) - return FAILURE; + if (!update_ppc_arglist (e)) + return false; gfc_ppc_use (comp, &e->value.compcall.actual, &e->where); - return SUCCESS; + return true; } @@ -5937,14 +5935,14 @@ gfc_is_expandable_expr (gfc_expr *e) with their operators, intrinsic operators are converted to function calls for overloaded types and unresolved function references are resolved. */ -gfc_try +bool gfc_resolve_expr (gfc_expr *e) { - gfc_try t; + bool t; bool inquiry_save, actual_arg_save, first_actual_arg_save; if (e == NULL) - return SUCCESS; + return true; /* inquiry_argument only applies to variables. */ inquiry_save = inquiry_argument; @@ -5972,7 +5970,7 @@ gfc_resolve_expr (gfc_expr *e) else { t = resolve_variable (e); - if (t == SUCCESS) + if (t) expression_rank (e); } @@ -5992,7 +5990,7 @@ gfc_resolve_expr (gfc_expr *e) case EXPR_CONSTANT: case EXPR_NULL: - t = SUCCESS; + t = true; break; case EXPR_PPC: @@ -6000,13 +5998,13 @@ gfc_resolve_expr (gfc_expr *e) break; case EXPR_ARRAY: - t = FAILURE; - if (resolve_ref (e) == FAILURE) + t = false; + if (!resolve_ref (e)) break; t = gfc_resolve_array_constructor (e); /* Also try to expand a constructor. */ - if (t == SUCCESS) + if (t) { expression_rank (e); if (gfc_is_constant_expr (e) || gfc_is_expandable_expr (e)) @@ -6016,7 +6014,7 @@ gfc_resolve_expr (gfc_expr *e) /* This provides the opportunity for the length of constructors with character valued function elements to propagate the string length to the expression. */ - if (t == SUCCESS && e->ts.type == BT_CHARACTER) + if (t && e->ts.type == BT_CHARACTER) { /* For efficiency, we call gfc_expand_constructor for BT_CHARACTER here rather then add a duplicate test for it above. */ @@ -6028,11 +6026,11 @@ gfc_resolve_expr (gfc_expr *e) case EXPR_STRUCTURE: t = resolve_ref (e); - if (t == FAILURE) + if (!t) break; t = resolve_structure_cons (e, 0); - if (t == FAILURE) + if (!t) break; t = gfc_simplify_expr (e, 0); @@ -6042,7 +6040,7 @@ gfc_resolve_expr (gfc_expr *e) gfc_internal_error ("gfc_resolve_expr(): Bad expression type"); } - if (e->ts.type == BT_CHARACTER && t == SUCCESS && !e->ts.u.cl) + if (e->ts.type == BT_CHARACTER && t && !e->ts.u.cl) fixup_charlen (e); inquiry_argument = inquiry_save; @@ -6056,17 +6054,17 @@ gfc_resolve_expr (gfc_expr *e) /* Resolve an expression from an iterator. They must be scalar and have INTEGER or (optionally) REAL type. */ -static gfc_try +static bool gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, const char *name_msgid) { - if (gfc_resolve_expr (expr) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (expr)) + return false; if (expr->rank != 0) { gfc_error ("%s at %L must be a scalar", _(name_msgid), &expr->where); - return FAILURE; + return false; } if (expr->ts.type != BT_INTEGER) @@ -6081,16 +6079,16 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, { gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where); - return FAILURE; + return false; } } else { gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } @@ -6099,29 +6097,27 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, Set own_scope to true for ac-implied-do and data-implied-do as those have a separate scope such that, e.g., a INTENT(IN) doesn't apply. */ -gfc_try +bool gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope) { - if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable") - == FAILURE) - return FAILURE; + if (!gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable")) + return false; - if (gfc_check_vardef_context (iter->var, false, false, own_scope, - _("iterator variable")) - == FAILURE) - return FAILURE; + if (!gfc_check_vardef_context (iter->var, false, false, own_scope, + _("iterator variable"))) + return false; - if (gfc_resolve_iterator_expr (iter->start, real_ok, - "Start expression in DO loop") == FAILURE) - return FAILURE; + if (!gfc_resolve_iterator_expr (iter->start, real_ok, + "Start expression in DO loop")) + return false; - if (gfc_resolve_iterator_expr (iter->end, real_ok, - "End expression in DO loop") == FAILURE) - return FAILURE; + if (!gfc_resolve_iterator_expr (iter->end, real_ok, + "End expression in DO loop")) + return false; - if (gfc_resolve_iterator_expr (iter->step, real_ok, - "Step expression in DO loop") == FAILURE) - return FAILURE; + if (!gfc_resolve_iterator_expr (iter->step, real_ok, + "Step expression in DO loop")) + return false; if (iter->step->expr_type == EXPR_CONSTANT) { @@ -6132,7 +6128,7 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope) { gfc_error ("Step expression in DO loop at %L cannot be zero", &iter->step->where); - return FAILURE; + return false; } } @@ -6169,7 +6165,7 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope) &iter->step->where); } - return SUCCESS; + return true; } @@ -6198,15 +6194,15 @@ forall_index (gfc_expr *expr, gfc_symbol *sym, int *f) /* Check whether the FORALL index appears in the expression or not. - Returns SUCCESS if SYM is found in EXPR. */ + Returns true if SYM is found in EXPR. */ -gfc_try +bool find_forall_index (gfc_expr *expr, gfc_symbol *sym, int f) { if (gfc_traverse_expr (expr, sym, forall_index, f)) - return SUCCESS; + return true; else - return FAILURE; + return false; } @@ -6224,33 +6220,33 @@ resolve_forall_iterators (gfc_forall_iterator *it) for (iter = it; iter; iter = iter->next) { - if (gfc_resolve_expr (iter->var) == SUCCESS + if (gfc_resolve_expr (iter->var) && (iter->var->ts.type != BT_INTEGER || iter->var->rank != 0)) gfc_error ("FORALL index-name at %L must be a scalar INTEGER", &iter->var->where); - if (gfc_resolve_expr (iter->start) == SUCCESS + if (gfc_resolve_expr (iter->start) && (iter->start->ts.type != BT_INTEGER || iter->start->rank != 0)) gfc_error ("FORALL start expression at %L must be a scalar INTEGER", &iter->start->where); if (iter->var->ts.kind != iter->start->ts.kind) gfc_convert_type (iter->start, &iter->var->ts, 1); - if (gfc_resolve_expr (iter->end) == SUCCESS + if (gfc_resolve_expr (iter->end) && (iter->end->ts.type != BT_INTEGER || iter->end->rank != 0)) gfc_error ("FORALL end expression at %L must be a scalar INTEGER", &iter->end->where); if (iter->var->ts.kind != iter->end->ts.kind) gfc_convert_type (iter->end, &iter->var->ts, 1); - if (gfc_resolve_expr (iter->stride) == SUCCESS) + if (gfc_resolve_expr (iter->stride)) { if (iter->stride->ts.type != BT_INTEGER || iter->stride->rank != 0) gfc_error ("FORALL stride expression at %L must be a scalar %s", &iter->stride->where, "INTEGER"); if (iter->stride->expr_type == EXPR_CONSTANT - && mpz_cmp_ui(iter->stride->value.integer, 0) == 0) + && mpz_cmp_ui (iter->stride->value.integer, 0) == 0) gfc_error ("FORALL stride expression at %L cannot be zero", &iter->stride->where); } @@ -6261,12 +6257,9 @@ resolve_forall_iterators (gfc_forall_iterator *it) for (iter = it; iter; iter = iter->next) for (iter2 = iter; iter2; iter2 = iter2->next) { - if (find_forall_index (iter2->start, - iter->var->symtree->n.sym, 0) == SUCCESS - || find_forall_index (iter2->end, - iter->var->symtree->n.sym, 0) == SUCCESS - || find_forall_index (iter2->stride, - iter->var->symtree->n.sym, 0) == SUCCESS) + if (find_forall_index (iter2->start, iter->var->symtree->n.sym, 0) + || find_forall_index (iter2->end, iter->var->symtree->n.sym, 0) + || find_forall_index (iter2->stride, iter->var->symtree->n.sym, 0)) gfc_error ("FORALL index '%s' may not appear in triplet " "specification at %L", iter->var->symtree->name, &iter2->start->where); @@ -6300,7 +6293,7 @@ derived_inaccessible (gfc_symbol *sym) /* Resolve the argument of a deallocate expression. The expression must be a pointer or a full array. */ -static gfc_try +static bool resolve_deallocate_expr (gfc_expr *e) { symbol_attribute attr; @@ -6310,8 +6303,8 @@ resolve_deallocate_expr (gfc_expr *e) gfc_component *c; bool unlimited; - if (gfc_resolve_expr (e) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (e)) + return false; if (e->expr_type != EXPR_VARIABLE) goto bad; @@ -6367,25 +6360,25 @@ resolve_deallocate_expr (gfc_expr *e) bad: gfc_error ("Allocate-object at %L must be ALLOCATABLE or a POINTER", &e->where); - return FAILURE; + return false; } /* F2008, C644. */ if (gfc_is_coindexed (e)) { gfc_error ("Coindexed allocatable object at %L", &e->where); - return FAILURE; + return false; } if (pointer - && gfc_check_vardef_context (e, true, true, false, _("DEALLOCATE object")) - == FAILURE) - return FAILURE; - if (gfc_check_vardef_context (e, false, true, false, _("DEALLOCATE object")) - == FAILURE) - return FAILURE; + && !gfc_check_vardef_context (e, true, true, false, + _("DEALLOCATE object"))) + return false; + if (!gfc_check_vardef_context (e, false, true, false, + _("DEALLOCATE object"))) + return false; - return SUCCESS; + return true; } @@ -6469,7 +6462,7 @@ remove_last_array_ref (gfc_expr* e) a source-expr are conformable. This does not catch all possible cases; in particular a runtime checking is needed. */ -static gfc_try +static bool conformable_arrays (gfc_expr *e1, gfc_expr *e2) { gfc_ref *tail; @@ -6481,7 +6474,7 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2) gfc_error ("Source-expr at %L must be scalar or have the " "same rank as the allocate-object at %L", &e1->where, &e2->where); - return FAILURE; + return false; } if (e1->shape) @@ -6509,14 +6502,14 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2) gfc_error ("Source-expr at %L and allocate-object at %L must " "have the same shape", &e1->where, &e2->where); mpz_clear (s); - return FAILURE; + return false; } } mpz_clear (s); } - return SUCCESS; + return true; } @@ -6524,7 +6517,7 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2) checks to see whether the expression is OK or not. The expression must have a trailing array reference that gives the size of the array. */ -static gfc_try +static bool resolve_allocate_expr (gfc_expr *e, gfc_code *code) { int i, pointer, allocatable, dimension, is_abstract; @@ -6538,7 +6531,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) gfc_symbol *sym = NULL; gfc_alloc *a; gfc_component *c; - gfc_try t; + bool t; /* Mark the utmost array component as being in allocate to allow DIMEN_STAR checking of coarrays. */ @@ -6549,7 +6542,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) if (ref && ref->type == REF_ARRAY) ref->u.ar.in_allocate = true; - if (gfc_resolve_expr (e) == FAILURE) + if (!gfc_resolve_expr (e)) goto failure; /* Make sure the expression is allocatable or a pointer. If it is @@ -6671,7 +6664,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) /* Check F03:C632 and restriction following Note 6.18. */ if (code->expr3->rank > 0 && !unlimited - && conformable_arrays (code->expr3, e) == FAILURE) + && !conformable_arrays (code->expr3, e)) goto failure; /* Check F03:C633. */ @@ -6726,13 +6719,15 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) on the expression. This is fooled by the array specification present in e, thus we have to eliminate that one temporarily. */ e2 = remove_last_array_ref (e); - t = SUCCESS; - if (t == SUCCESS && pointer) - t = gfc_check_vardef_context (e2, true, true, false, _("ALLOCATE object")); - if (t == SUCCESS) - t = gfc_check_vardef_context (e2, false, true, false, _("ALLOCATE object")); + t = true; + if (t && pointer) + t = gfc_check_vardef_context (e2, true, true, false, + _("ALLOCATE object")); + if (t) + t = gfc_check_vardef_context (e2, false, true, false, + _("ALLOCATE object")); gfc_free_expr (e2); - if (t == FAILURE) + if (!t) goto failure; if (e->ts.type == BT_CLASS && CLASS_DATA (e)->attr.dimension @@ -6914,10 +6909,10 @@ check_symbols: } success: - return SUCCESS; + return true; failure: - return FAILURE; + return false; } static void @@ -6932,7 +6927,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) /* Check the stat variable. */ if (stat) { - gfc_check_vardef_context (stat, false, false, false, _("STAT variable")); + gfc_check_vardef_context (stat, false, false, false, + _("STAT variable")); if ((stat->ts.type != BT_INTEGER && !(stat->ref && (stat->ref->type == REF_ARRAY @@ -7294,18 +7290,18 @@ check_case_overlap (gfc_case *list) /* Check to see if an expression is suitable for use in a CASE statement. Makes sure that all case expressions are scalar constants of the same - type. Return FAILURE if anything is wrong. */ + type. Return false if anything is wrong. */ -static gfc_try +static bool validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr) { - if (e == NULL) return SUCCESS; + if (e == NULL) return true; if (e->ts.type != case_expr->ts.type) { gfc_error ("Expression in CASE statement at %L must be of type %s", &e->where, gfc_basic_typename (case_expr->ts.type)); - return FAILURE; + return false; } /* C805 (R808) For a given case-construct, each case-value shall be of @@ -7316,7 +7312,7 @@ validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr) { gfc_error ("Expression in CASE statement at %L must be of kind %d", &e->where, case_expr->ts.kind); - return FAILURE; + return false; } /* Convert the case value kind to that of case expression kind, @@ -7329,10 +7325,10 @@ validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr) { gfc_error ("Expression in CASE statement at %L must be scalar", &e->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -7366,7 +7362,7 @@ resolve_select (gfc_code *code, bool select_type) int seen_logical; int ncases; bt type; - gfc_try t; + bool t; if (code->expr1 == NULL) { @@ -7475,7 +7471,7 @@ resolve_select (gfc_code *code, bool select_type) for (body = code->block; body; body = body->block) { /* Assume the CASE list is OK, and all CASE labels can be matched. */ - t = SUCCESS; + t = true; seen_unreachable = 0; /* Walk the case label list, making sure that all case labels @@ -7493,7 +7489,7 @@ resolve_select (gfc_code *code, bool select_type) gfc_error ("The DEFAULT CASE at %L cannot be followed " "by a second DEFAULT CASE at %L", &default_case->where, &cp->where); - t = FAILURE; + t = false; break; } else @@ -7505,10 +7501,10 @@ resolve_select (gfc_code *code, bool select_type) /* Deal with single value cases and case ranges. Errors are issued from the validation function. */ - if (validate_case_label_expr (cp->low, case_expr) != SUCCESS - || validate_case_label_expr (cp->high, case_expr) != SUCCESS) + if (!validate_case_label_expr (cp->low, case_expr) + || !validate_case_label_expr (cp->high, case_expr)) { - t = FAILURE; + t = false; break; } @@ -7518,7 +7514,7 @@ resolve_select (gfc_code *code, bool select_type) { gfc_error ("Logical range in CASE statement at %L is not " "allowed", &cp->low->where); - t = FAILURE; + t = false; break; } @@ -7531,7 +7527,7 @@ resolve_select (gfc_code *code, bool select_type) gfc_error ("Constant logical value in CASE statement " "is repeated at %L", &cp->low->where); - t = FAILURE; + t = false; break; } seen_logical |= value; @@ -7571,7 +7567,7 @@ resolve_select (gfc_code *code, bool select_type) /* It there was a failure in the previous case label, give up for this case label list. Continue with the next block. */ - if (t == FAILURE) + if (!t) continue; /* See if any case labels that are unreachable have been seen. @@ -7680,7 +7676,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) return; gcc_assert (!sym->assoc->dangling); - if (resolve_target && gfc_resolve_expr (target) != SUCCESS) + if (resolve_target && !gfc_resolve_expr (target)) return; /* For variable targets, we get some attributes from the target. */ @@ -8147,8 +8143,8 @@ resolve_transfer (gfc_code *code) code->ext.dt may be NULL if the TRANSFER is related to an INQUIRE statement -- but in this case, we are not reading, either. */ if (code->ext.dt && code->ext.dt->dt_io_kind->value.iokind == M_READ - && gfc_check_vardef_context (exp, false, false, false, _("item in READ")) - == FAILURE) + && !gfc_check_vardef_context (exp, false, false, false, + _("item in READ"))) return; sym = exp->symtree->n.sym; @@ -8201,8 +8197,8 @@ resolve_transfer (gfc_code *code) the component to be printed to help debugging. */ if (ts->u.derived->ts.f90_type == BT_VOID) { - if (gfc_notify_std (GFC_STD_GNU, "Data transfer element at %L cannot " - "have PRIVATE components", &code->loc) == FAILURE) + if (!gfc_notify_std (GFC_STD_GNU, "Data transfer element at %L " + "cannot have PRIVATE components", &code->loc)) return; } else if (derived_inaccessible (ts->u.derived)) @@ -8277,8 +8273,8 @@ resolve_lock_unlock (gfc_code *code) &code->expr2->where); if (code->expr2 - && gfc_check_vardef_context (code->expr2, false, false, false, - _("STAT variable")) == FAILURE) + && !gfc_check_vardef_context (code->expr2, false, false, false, + _("STAT variable"))) return; /* Check ERRMSG. */ @@ -8289,8 +8285,8 @@ resolve_lock_unlock (gfc_code *code) &code->expr3->where); if (code->expr3 - && gfc_check_vardef_context (code->expr3, false, false, false, - _("ERRMSG variable")) == FAILURE) + && !gfc_check_vardef_context (code->expr3, false, false, false, + _("ERRMSG variable"))) return; /* Check ACQUIRED_LOCK. */ @@ -8301,8 +8297,8 @@ resolve_lock_unlock (gfc_code *code) "variable", &code->expr4->where); if (code->expr4 - && gfc_check_vardef_context (code->expr4, false, false, false, - _("ACQUIRED_LOCK variable")) == FAILURE) + && !gfc_check_vardef_context (code->expr4, false, false, false, + _("ACQUIRED_LOCK variable"))) return; } @@ -8321,7 +8317,7 @@ resolve_sync (gfc_code *code) gfc_error ("Imageset argument at %L must between 1 and num_images()", &code->expr1->where); else if (code->expr1->expr_type == EXPR_ARRAY - && gfc_simplify_expr (code->expr1, 0) == SUCCESS) + && gfc_simplify_expr (code->expr1, 0)) { gfc_constructor *cons; cons = gfc_constructor_first (code->expr1->value.constructor); @@ -8450,12 +8446,12 @@ resolve_branch (gfc_st_label *label, gfc_code *code) /* Check whether EXPR1 has the same shape as EXPR2. */ -static gfc_try +static bool resolve_where_shape (gfc_expr *expr1, gfc_expr *expr2) { mpz_t shape[GFC_MAX_DIMENSIONS]; mpz_t shape2[GFC_MAX_DIMENSIONS]; - gfc_try result = FAILURE; + bool result = false; int i; /* Compare the rank. */ @@ -8465,10 +8461,10 @@ resolve_where_shape (gfc_expr *expr1, gfc_expr *expr2) /* Compare the size of each dimension. */ for (i=0; i<expr1->rank; i++) { - if (gfc_array_dimen_size (expr1, i, &shape[i]) == FAILURE) + if (!gfc_array_dimen_size (expr1, i, &shape[i])) goto ignore; - if (gfc_array_dimen_size (expr2, i, &shape2[i]) == FAILURE) + if (!gfc_array_dimen_size (expr2, i, &shape2[i])) goto ignore; if (mpz_cmp (shape[i], shape2[i])) @@ -8478,7 +8474,7 @@ resolve_where_shape (gfc_expr *expr1, gfc_expr *expr2) /* When either of the two expression is an assumed size array, we ignore the comparison of dimension sizes. */ ignore: - result = SUCCESS; + result = true; over: gfc_clear_shape (shape, i); @@ -8512,7 +8508,7 @@ resolve_where (gfc_code *code, gfc_expr *mask) { /* Check if the mask-expr has a consistent shape with the outmost WHERE mask-expr. */ - if (resolve_where_shape (cblock->expr1, e) == FAILURE) + if (!resolve_where_shape (cblock->expr1, e)) gfc_error ("WHERE mask at %L has inconsistent shape", &cblock->expr1->where); } @@ -8528,7 +8524,7 @@ resolve_where (gfc_code *code, gfc_expr *mask) case EXEC_ASSIGN: /* Check shape consistent for WHERE assignment target. */ - if (e && resolve_where_shape (cnext->expr1, e) == FAILURE) + if (e && !resolve_where_shape (cnext->expr1, e)) gfc_error ("WHERE assignment target at %L has " "inconsistent shape", &cnext->expr1->where); break; @@ -8586,7 +8582,7 @@ gfc_resolve_assign_in_forall (gfc_code *code, int nvar, gfc_expr **var_expr) assignment variable, then there could be a many-to-one assignment. Emit a warning rather than an error because the mask could be resolving this problem. */ - if (find_forall_index (code->expr1, forall_index, 0) == FAILURE) + if (!find_forall_index (code->expr1, forall_index, 0)) gfc_warning ("The FORALL with index '%s' is not used on the " "left side of the assignment at %L and so might " "cause multiple assignment to this object", @@ -8815,25 +8811,25 @@ static void resolve_code (gfc_code *, gfc_namespace *); void gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) { - gfc_try t; + bool t; for (; b; b = b->block) { t = gfc_resolve_expr (b->expr1); - if (gfc_resolve_expr (b->expr2) == FAILURE) - t = FAILURE; + if (!gfc_resolve_expr (b->expr2)) + t = false; switch (b->op) { case EXEC_IF: - if (t == SUCCESS && b->expr1 != NULL + if (t && b->expr1 != NULL && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0)) gfc_error ("IF clause at %L requires a scalar LOGICAL expression", &b->expr1->where); break; case EXEC_WHERE: - if (t == SUCCESS + if (t && b->expr1 != NULL && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank == 0)) gfc_error ("WHERE/ELSEWHERE clause at %L requires a LOGICAL array", @@ -8900,7 +8896,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) int n; gfc_ref *ref; - if (gfc_extend_assign (code, ns) == SUCCESS) + if (gfc_extend_assign (code, ns)) { gfc_expr** rhsptr; @@ -8939,9 +8935,9 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) rhs = code->expr2; if (rhs->is_boz - && gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside " - "a DATA statement and outside INT/REAL/DBLE/CMPLX", - &code->loc) == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside " + "a DATA statement and outside INT/REAL/DBLE/CMPLX", + &code->loc)) return false; /* Handle the case of a BOZ literal on the RHS. */ @@ -9499,7 +9495,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) int omp_workshare_save; int forall_save, do_concurrent_save; code_stack frame; - gfc_try t; + bool t; frame.prev = cs_base; frame.head = code; @@ -9562,18 +9558,18 @@ resolve_code (gfc_code *code, gfc_namespace *ns) omp_workshare_flag = omp_workshare_save; } - t = SUCCESS; + t = true; if (code->op != EXEC_COMPCALL && code->op != EXEC_CALL_PPC) t = gfc_resolve_expr (code->expr1); forall_flag = forall_save; do_concurrent_flag = do_concurrent_save; - if (gfc_resolve_expr (code->expr2) == FAILURE) - t = FAILURE; + if (!gfc_resolve_expr (code->expr2)) + t = false; if (code->op == EXEC_ALLOCATE - && gfc_resolve_expr (code->expr3) == FAILURE) - t = FAILURE; + && !gfc_resolve_expr (code->expr3)) + t = false; switch (code->op) { @@ -9638,11 +9634,11 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_ASSIGN: - if (t == FAILURE) + if (!t) break; - if (gfc_check_vardef_context (code->expr1, false, false, false, - _("assignment")) == FAILURE) + if (!gfc_check_vardef_context (code->expr1, false, false, false, + _("assignment"))) break; if (resolve_ordinary_assign (code, ns)) @@ -9664,7 +9660,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) if (code->label1->defined == ST_LABEL_UNKNOWN) gfc_error ("Label %d referenced at %L is never defined", code->label1->value, &code->label1->where); - if (t == SUCCESS + if (t && (code->expr1->expr_type != EXPR_VARIABLE || code->expr1->symtree->n.sym->ts.type != BT_INTEGER || code->expr1->symtree->n.sym->ts.kind @@ -9678,7 +9674,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) { gfc_expr* e; - if (t == FAILURE) + if (!t) break; /* This is both a variable definition and pointer assignment @@ -9688,11 +9684,11 @@ resolve_code (gfc_code *code, gfc_namespace *ns) e = remove_last_array_ref (code->expr1); t = gfc_check_vardef_context (e, true, false, false, _("pointer assignment")); - if (t == SUCCESS) + if (t) t = gfc_check_vardef_context (e, false, false, false, _("pointer assignment")); gfc_free_expr (e); - if (t == FAILURE) + if (!t) break; gfc_check_pointer_assign (code->expr1, code->expr2); @@ -9700,7 +9696,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) } case EXEC_ARITHMETIC_IF: - if (t == SUCCESS + if (t && code->expr1->ts.type != BT_INTEGER && code->expr1->ts.type != BT_REAL) gfc_error ("Arithmetic IF statement at %L requires a numeric " @@ -9712,7 +9708,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_IF: - if (t == SUCCESS && code->expr1 != NULL + if (t && code->expr1 != NULL && (code->expr1->ts.type != BT_LOGICAL || code->expr1->rank != 0)) gfc_error ("IF clause at %L requires a scalar LOGICAL expression", @@ -9751,7 +9747,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) if (code->ext.iterator != NULL) { gfc_iterator *iter = code->ext.iterator; - if (gfc_resolve_iterator (iter, true, false) != FAILURE) + if (gfc_resolve_iterator (iter, true, false)) gfc_resolve_do_iterator (code, iter->var->symtree->n.sym); } break; @@ -9759,7 +9755,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_DO_WHILE: if (code->expr1 == NULL) gfc_internal_error ("resolve_code(): No expression on DO WHILE"); - if (t == SUCCESS + if (t && (code->expr1->rank != 0 || code->expr1->ts.type != BT_LOGICAL)) gfc_error ("Exit condition of DO WHILE loop at %L must be " @@ -9767,26 +9763,26 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_ALLOCATE: - if (t == SUCCESS) + if (t) resolve_allocate_deallocate (code, "ALLOCATE"); break; case EXEC_DEALLOCATE: - if (t == SUCCESS) + if (t) resolve_allocate_deallocate (code, "DEALLOCATE"); break; case EXEC_OPEN: - if (gfc_resolve_open (code->ext.open) == FAILURE) + if (!gfc_resolve_open (code->ext.open)) break; resolve_branch (code->ext.open->err, code); break; case EXEC_CLOSE: - if (gfc_resolve_close (code->ext.close) == FAILURE) + if (!gfc_resolve_close (code->ext.close)) break; resolve_branch (code->ext.close->err, code); @@ -9796,14 +9792,14 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_ENDFILE: case EXEC_REWIND: case EXEC_FLUSH: - if (gfc_resolve_filepos (code->ext.filepos) == FAILURE) + if (!gfc_resolve_filepos (code->ext.filepos)) break; resolve_branch (code->ext.filepos->err, code); break; case EXEC_INQUIRE: - if (gfc_resolve_inquire (code->ext.inquire) == FAILURE) + if (!gfc_resolve_inquire (code->ext.inquire)) break; resolve_branch (code->ext.inquire->err, code); @@ -9811,14 +9807,14 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_IOLENGTH: gcc_assert (code->ext.inquire != NULL); - if (gfc_resolve_inquire (code->ext.inquire) == FAILURE) + if (!gfc_resolve_inquire (code->ext.inquire)) break; resolve_branch (code->ext.inquire->err, code); break; case EXEC_WAIT: - if (gfc_resolve_wait (code->ext.wait) == FAILURE) + if (!gfc_resolve_wait (code->ext.wait)) break; resolve_branch (code->ext.wait->err, code); @@ -9828,7 +9824,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_READ: case EXEC_WRITE: - if (gfc_resolve_dt (code->ext.dt, &code->loc) == FAILURE) + if (!gfc_resolve_dt (code->ext.dt, &code->loc)) break; resolve_branch (code->ext.dt->err, code); @@ -9891,7 +9887,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) static void resolve_values (gfc_symbol *sym) { - gfc_try t; + bool t; if (sym->value == NULL) return; @@ -9901,7 +9897,7 @@ resolve_values (gfc_symbol *sym) else t = gfc_resolve_expr (sym->value); - if (t == FAILURE) + if (!t) return; gfc_check_assign_symbol (sym, NULL, sym->value); @@ -10109,32 +10105,32 @@ gfc_verify_binding_labels (gfc_symbol *sym) /* Resolve an index expression. */ -static gfc_try +static bool resolve_index_expr (gfc_expr *e) { - if (gfc_resolve_expr (e) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (e)) + return false; - if (gfc_simplify_expr (e, 0) == FAILURE) - return FAILURE; + if (!gfc_simplify_expr (e, 0)) + return false; - if (gfc_specification_expr (e) == FAILURE) - return FAILURE; + if (!gfc_specification_expr (e)) + return false; - return SUCCESS; + return true; } /* Resolve a charlen structure. */ -static gfc_try +static bool resolve_charlen (gfc_charlen *cl) { int i, k; bool saved_specification_expr; if (cl->resolved) - return SUCCESS; + return true; cl->resolved = 1; saved_specification_expr = specification_expr; @@ -10142,25 +10138,25 @@ resolve_charlen (gfc_charlen *cl) if (cl->length_from_typespec) { - if (gfc_resolve_expr (cl->length) == FAILURE) + if (!gfc_resolve_expr (cl->length)) { specification_expr = saved_specification_expr; - return FAILURE; + return false; } - if (gfc_simplify_expr (cl->length, 0) == FAILURE) + if (!gfc_simplify_expr (cl->length, 0)) { specification_expr = saved_specification_expr; - return FAILURE; + return false; } } else { - if (resolve_index_expr (cl->length) == FAILURE) + if (!resolve_index_expr (cl->length)) { specification_expr = saved_specification_expr; - return FAILURE; + return false; } } @@ -10184,11 +10180,11 @@ resolve_charlen (gfc_charlen *cl) { gfc_error ("String length at %L is too large", &cl->length->where); specification_expr = saved_specification_expr; - return FAILURE; + return false; } specification_expr = saved_specification_expr; - return SUCCESS; + return true; } @@ -10210,11 +10206,11 @@ is_non_constant_shape_array (gfc_symbol *sym) for (i = 0; i < sym->as->rank + sym->as->corank; i++) { e = sym->as->lower[i]; - if (e && (resolve_index_expr (e) == FAILURE + if (e && (!resolve_index_expr(e) || !gfc_is_constant_expr (e))) not_constant = true; e = sym->as->upper[i]; - if (e && (resolve_index_expr (e) == FAILURE + if (e && (!resolve_index_expr(e) || !gfc_is_constant_expr (e))) not_constant = true; } @@ -10486,7 +10482,7 @@ apply_default_init_local (gfc_symbol *sym) /* Resolution of common features of flavors variable and procedure. */ -static gfc_try +static bool resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) { gfc_array_spec *as; @@ -10520,19 +10516,19 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) { gfc_error ("Allocatable array '%s' at %L must have a deferred " "shape or assumed rank", sym->name, &sym->declared_at); - return FAILURE; + return false; } - else if (gfc_notify_std (GFC_STD_F2003, "Scalar object " - "'%s' at %L may not be ALLOCATABLE", - sym->name, &sym->declared_at) == FAILURE) - return FAILURE; + else if (!gfc_notify_std (GFC_STD_F2003, "Scalar object " + "'%s' at %L may not be ALLOCATABLE", + sym->name, &sym->declared_at)) + return false; } if (pointer && dimension && as->type != AS_ASSUMED_RANK) { gfc_error ("Array pointer '%s' at %L must have a deferred shape or " "assumed rank", sym->name, &sym->declared_at); - return FAILURE; + return false; } } else @@ -10542,7 +10538,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) { gfc_error ("Array '%s' at %L cannot have a deferred shape", sym->name, &sym->declared_at); - return FAILURE; + return false; } } @@ -10552,13 +10548,13 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) /* F03:C502. */ if (sym->attr.class_ok && !sym->attr.select_type_temporary - && !UNLIMITED_POLY(sym) + && !UNLIMITED_POLY (sym) && !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived)) { gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible", CLASS_DATA (sym)->ts.u.derived->name, sym->name, &sym->declared_at); - return FAILURE; + return false; } /* F03:C509. */ @@ -10569,18 +10565,18 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) { gfc_error ("CLASS variable '%s' at %L must be dummy, allocatable " "or pointer", sym->name, &sym->declared_at); - return FAILURE; + return false; } } - return SUCCESS; + return true; } /* Additional checks for symbols with flavor variable and derived type. To be called from resolve_fl_variable. */ -static gfc_try +static bool resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) { gcc_assert (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS); @@ -10603,7 +10599,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) "of the same name declared at %L", sym->ts.u.derived->name, &sym->declared_at, &s->declared_at); - return FAILURE; + return false; } } @@ -10620,11 +10616,10 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) && !sym->ns->save_all && !sym->attr.save && !sym->attr.pointer && !sym->attr.allocatable && gfc_has_default_initializer (sym->ts.u.derived) - && gfc_notify_std (GFC_STD_F2008, "Implied SAVE for " - "module variable '%s' at %L, needed due to " - "the default initialization", sym->name, - &sym->declared_at) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2008, "Implied SAVE for module variable " + "'%s' at %L, needed due to the default " + "initialization", sym->name, &sym->declared_at)) + return false; /* Assign default initializer. */ if (!(sym->value || sym->attr.pointer || sym->attr.allocatable) @@ -10633,13 +10628,13 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) sym->value = gfc_default_initializer (&sym->ts); } - return SUCCESS; + return true; } /* Resolve symbols with flavor variable. */ -static gfc_try +static bool resolve_fl_variable (gfc_symbol *sym, int mp_flag) { int no_init_flag, automatic_flag; @@ -10650,8 +10645,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) auto_save_msg = "Automatic object '%s' at %L cannot have the " "SAVE attribute"; - if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE) - return FAILURE; + if (!resolve_fl_var_and_proc (sym, mp_flag)) + return false; /* Set this flag to check that variables are parameters of all entries. This check is effected by the call to gfc_resolve_expr through @@ -10672,7 +10667,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) gfc_error ("The module or main program array '%s' at %L must " "have constant shape", sym->name, &sym->declared_at); specification_expr = saved_specification_expr; - return FAILURE; + return false; } /* Constraints on deferred type parameter. */ @@ -10682,7 +10677,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) "requires either the pointer or allocatable attribute", sym->name, &sym->declared_at); specification_expr = saved_specification_expr; - return FAILURE; + return false; } if (sym->ts.type == BT_CHARACTER) @@ -10696,14 +10691,14 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) gfc_error ("Entity with assumed character length at %L must be a " "dummy argument or a PARAMETER", &sym->declared_at); specification_expr = saved_specification_expr; - return FAILURE; + return false; } if (e && sym->attr.save == SAVE_EXPLICIT && !gfc_is_constant_expr (e)) { gfc_error (auto_save_msg, sym->name, &sym->declared_at); specification_expr = saved_specification_expr; - return FAILURE; + return false; } if (!gfc_is_constant_expr (e) @@ -10717,14 +10712,14 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) gfc_error ("'%s' at %L must have constant character length " "in this context", sym->name, &sym->declared_at); specification_expr = saved_specification_expr; - return FAILURE; + return false; } if (sym->attr.in_common) { gfc_error ("COMMON variable '%s' at %L must have constant " "character length", sym->name, &sym->declared_at); specification_expr = saved_specification_expr; - return FAILURE; + return false; } } } @@ -10755,7 +10750,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) { gfc_error (auto_save_msg, sym->name, &sym->declared_at); specification_expr = saved_specification_expr; - return FAILURE; + return false; } } @@ -10789,47 +10784,47 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) else goto no_init_error; specification_expr = saved_specification_expr; - return FAILURE; + return false; } no_init_error: if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS) { - gfc_try res = resolve_fl_variable_derived (sym, no_init_flag); + bool res = resolve_fl_variable_derived (sym, no_init_flag); specification_expr = saved_specification_expr; return res; } specification_expr = saved_specification_expr; - return SUCCESS; + return true; } /* Resolve a procedure. */ -static gfc_try +static bool resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_formal_arglist *arg; if (sym->attr.function - && resolve_fl_var_and_proc (sym, mp_flag) == FAILURE) - return FAILURE; + && !resolve_fl_var_and_proc (sym, mp_flag)) + return false; if (sym->ts.type == BT_CHARACTER) { gfc_charlen *cl = sym->ts.u.cl; if (cl && cl->length && gfc_is_constant_expr (cl->length) - && resolve_charlen (cl) == FAILURE) - return FAILURE; + && !resolve_charlen (cl)) + return false; if ((!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT) && sym->attr.proc == PROC_ST_FUNCTION) { gfc_error ("Character-valued statement function '%s' at %L must " "have constant length", sym->name, &sym->declared_at); - return FAILURE; + return false; } } @@ -10849,15 +10844,15 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) && arg->sym->ts.type == BT_DERIVED && !arg->sym->ts.u.derived->attr.use_assoc && !gfc_check_symbol_access (arg->sym->ts.u.derived) - && gfc_notify_std (GFC_STD_F2003, "'%s' is of a " - "PRIVATE type and cannot be a dummy argument" - " of '%s', which is PUBLIC at %L", - arg->sym->name, sym->name, &sym->declared_at) - == FAILURE) + && !gfc_notify_std (GFC_STD_F2003, "'%s' is of a PRIVATE type " + "and cannot be a dummy argument" + " of '%s', which is PUBLIC at %L", + arg->sym->name, sym->name, + &sym->declared_at)) { /* Stop this message from recurring. */ arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC; - return FAILURE; + return false; } } @@ -10871,16 +10866,16 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) && arg->sym->ts.type == BT_DERIVED && !arg->sym->ts.u.derived->attr.use_assoc && !gfc_check_symbol_access (arg->sym->ts.u.derived) - && gfc_notify_std (GFC_STD_F2003, "Procedure " - "'%s' in PUBLIC interface '%s' at %L " - "takes dummy arguments of '%s' which is " - "PRIVATE", iface->sym->name, sym->name, - &iface->sym->declared_at, - gfc_typename (&arg->sym->ts)) == FAILURE) + && !gfc_notify_std (GFC_STD_F2003, "Procedure '%s' in " + "PUBLIC interface '%s' at %L " + "takes dummy arguments of '%s' which " + "is PRIVATE", iface->sym->name, + sym->name, &iface->sym->declared_at, + gfc_typename(&arg->sym->ts))) { /* Stop this message from recurring. */ arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC; - return FAILURE; + return false; } } } @@ -10895,16 +10890,16 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) && arg->sym->ts.type == BT_DERIVED && !arg->sym->ts.u.derived->attr.use_assoc && !gfc_check_symbol_access (arg->sym->ts.u.derived) - && gfc_notify_std (GFC_STD_F2003, "Procedure " - "'%s' in PUBLIC interface '%s' at %L " - "takes dummy arguments of '%s' which is " - "PRIVATE", iface->sym->name, sym->name, - &iface->sym->declared_at, - gfc_typename (&arg->sym->ts)) == FAILURE) + && !gfc_notify_std (GFC_STD_F2003, "Procedure '%s' in " + "PUBLIC interface '%s' at %L takes " + "dummy arguments of '%s' which is " + "PRIVATE", iface->sym->name, + sym->name, &iface->sym->declared_at, + gfc_typename(&arg->sym->ts))) { /* Stop this message from recurring. */ arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC; - return FAILURE; + return false; } } } @@ -10915,7 +10910,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_error ("Function '%s' at %L cannot have an initializer", sym->name, &sym->declared_at); - return FAILURE; + return false; } /* An external symbol may not have an initializer because it is taken to be @@ -10924,7 +10919,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_error ("External object '%s' at %L may not have an initializer", sym->name, &sym->declared_at); - return FAILURE; + return false; } /* An elemental function is required to return a scalar 12.7.1 */ @@ -10934,7 +10929,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) "result", sym->name, &sym->declared_at); /* Reset so that the error only occurs once. */ sym->attr.elemental = 0; - return FAILURE; + return false; } if (sym->attr.proc == PROC_ST_FUNCTION @@ -10942,7 +10937,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_error ("Statement function '%s' at %L may not have pointer or " "allocatable attribute", sym->name, &sym->declared_at); - return FAILURE; + return false; } /* 5.1.1.5 of the Standard: A function name declared with an asterisk @@ -10974,7 +10969,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) gfc_error ("CHARACTER(*) function '%s' at %L cannot be " "recursive", sym->name, &sym->declared_at); - return FAILURE; + return false; } /* Appendix B.2 of the standard. Contained functions give an @@ -10993,8 +10988,8 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) gfc_formal_arglist *curr_arg; int has_non_interop_arg = 0; - if (verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common, - sym->common_block) == FAILURE) + if (!verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common, + sym->common_block)) { /* Clear these to prevent looking at them again if there was an error. */ @@ -11014,7 +11009,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { /* Skip implicitly typed dummy args here. */ if (curr_arg->sym->attr.implicit_type == 0) - if (gfc_verify_c_interop_param (curr_arg->sym) == FAILURE) + if (!gfc_verify_c_interop_param (curr_arg->sym)) /* If something is found to fail, record the fact so we can mark the symbol for the procedure as not being BIND(C) to try and prevent multiple errors being @@ -11040,19 +11035,19 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_error ("PROCEDURE attribute conflicts with SAVE attribute " "in '%s' at %L", sym->name, &sym->declared_at); - return FAILURE; + return false; } if (sym->attr.intent) { gfc_error ("PROCEDURE attribute conflicts with INTENT attribute " "in '%s' at %L", sym->name, &sym->declared_at); - return FAILURE; + return false; } if (sym->attr.subroutine && sym->attr.result) { gfc_error ("PROCEDURE attribute conflicts with RESULT attribute " "in '%s' at %L", sym->name, &sym->declared_at); - return FAILURE; + return false; } if (sym->attr.external && sym->attr.function && ((sym->attr.if_source == IFSRC_DECL && !sym->attr.procedure) @@ -11060,18 +11055,18 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_error ("EXTERNAL attribute conflicts with FUNCTION attribute " "in '%s' at %L", sym->name, &sym->declared_at); - return FAILURE; + return false; } if (strcmp ("ppr@", sym->name) == 0) { gfc_error ("Procedure pointer result '%s' at %L " "is missing the pointer attribute", sym->ns->proc_name->name, &sym->declared_at); - return FAILURE; + return false; } } - return SUCCESS; + return true; } @@ -11079,16 +11074,16 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) been defined and we now know their defined arguments, check that they fulfill the requirements of the standard for procedures used as finalizers. */ -static gfc_try +static bool gfc_resolve_finalizers (gfc_symbol* derived) { gfc_finalizer* list; gfc_finalizer** prev_link; /* For removing wrong entries from the list. */ - gfc_try result = SUCCESS; + bool result = true; bool seen_scalar = false; if (!derived->f2k_derived || !derived->f2k_derived->finalizers) - return SUCCESS; + return true; /* Walk over the list of finalizer-procedures, check them, and if any one does not fit in with the standard's definition, print an error and remove @@ -11210,7 +11205,7 @@ gfc_resolve_finalizers (gfc_symbol* derived) /* Remove wrong nodes immediately from the list so we don't risk any troubles in the future when they might fail later expectations. */ error: - result = FAILURE; + result = false; i = list; *prev_link = list->next; gfc_free_finalizer (i); @@ -11219,7 +11214,7 @@ error: /* Warn if we haven't seen a scalar finalizer procedure (but we know there were nodes in the list, must have been for arrays. It is surely a good idea to have a scalar version there if there's something to finalize. */ - if (gfc_option.warn_surprising && result == SUCCESS && !seen_scalar) + if (gfc_option.warn_surprising && result && !seen_scalar) gfc_warning ("Only array FINAL procedures declared for derived type '%s'" " defined at %L, suggest also scalar one", derived->name, &derived->declared_at); @@ -11235,7 +11230,7 @@ error: /* Check if two GENERIC targets are ambiguous and emit an error is they are. */ -static gfc_try +static bool check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, const char* generic_name, locus where) { @@ -11251,7 +11246,7 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, sym2 = t2->specific->u.specific->n.sym; if (sym1 == sym2) - return SUCCESS; + return true; /* Both must be SUBROUTINEs or both must be FUNCTIONs. */ if (sym1->attr.subroutine != sym2->attr.subroutine @@ -11260,7 +11255,7 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, gfc_error ("'%s' and '%s' can't be mixed FUNCTION/SUBROUTINE for" " GENERIC '%s' at %L", sym1->name, sym2->name, generic_name, &where); - return FAILURE; + return false; } /* Compare the interfaces. */ @@ -11281,10 +11276,10 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, { gfc_error ("'%s' and '%s' for GENERIC '%s' at %L are ambiguous", sym1->name, sym2->name, generic_name, &where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -11296,7 +11291,7 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, tb_uop_root or tb_op, respectively. Thus the caller must already find the super-type and set p->overridden correctly. */ -static gfc_try +static bool resolve_tb_generic_targets (gfc_symbol* super_type, gfc_typebound_proc* p, const char* name) { @@ -11340,7 +11335,7 @@ resolve_tb_generic_targets (gfc_symbol* super_type, gfc_error ("Undefined specific binding '%s' as target of GENERIC '%s'" " at %L", target_name, name, &p->where); - return FAILURE; + return false; /* Once we've found the specific binding, check it is not ambiguous with other specifics already found or inherited for the same GENERIC. */ @@ -11352,15 +11347,14 @@ specific_found: { gfc_error ("GENERIC '%s' at %L must target a specific binding," " '%s' is GENERIC, too", name, &p->where, target_name); - return FAILURE; + return false; } /* Check those already resolved on this type directly. */ for (g = p->u.generic; g; g = g->next) if (g != target && g->specific - && check_generic_tbp_ambiguity (target, g, name, p->where) - == FAILURE) - return FAILURE; + && !check_generic_tbp_ambiguity (target, g, name, p->where)) + return false; /* Check for ambiguity with inherited specific targets. */ for (overridden_tbp = p->overridden; overridden_tbp; @@ -11370,9 +11364,8 @@ specific_found: for (g = overridden_tbp->u.generic; g; g = g->next) { gcc_assert (g->specific); - if (check_generic_tbp_ambiguity (target, g, - name, p->where) == FAILURE) - return FAILURE; + if (!check_generic_tbp_ambiguity (target, g, name, p->where)) + return false; } } } @@ -11382,7 +11375,7 @@ specific_found: { gfc_error ("GENERIC '%s' at %L can't overwrite specific binding with" " the same name", name, &p->where); - return FAILURE; + return false; } /* Take the SUBROUTINE/FUNCTION attributes of the first specific target, as @@ -11392,13 +11385,13 @@ specific_found: p->subroutine = first_target->n.sym->attr.subroutine; p->function = first_target->n.sym->attr.function; - return SUCCESS; + return true; } /* Resolve a GENERIC procedure binding for a derived type. */ -static gfc_try +static bool resolve_typebound_generic (gfc_symbol* derived, gfc_symtree* st) { gfc_symbol* super_type; @@ -11446,7 +11439,7 @@ get_checked_tb_operator_target (gfc_tbp_generic* target, locus where) /* Resolve a type-bound intrinsic operator. */ -static gfc_try +static bool resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, gfc_typebound_proc* p) { @@ -11455,7 +11448,7 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, /* If there's already an error here, do nothing (but don't fail again). */ if (p->error) - return SUCCESS; + return true; /* Operators should always be GENERIC bindings. */ gcc_assert (p->is_generic); @@ -11469,7 +11462,7 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, p->overridden = NULL; /* Resolve general GENERIC properties using worker function. */ - if (resolve_tb_generic_targets (super_type, p, gfc_op2string (op)) == FAILURE) + if (!resolve_tb_generic_targets (super_type, p, gfc_op2string(op))) goto error; /* Check the targets to be procedures of correct interface. */ @@ -11489,9 +11482,8 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, && p->access != ACCESS_PRIVATE && derived->ns == gfc_current_ns) { gfc_interface *head, *intr; - if (gfc_check_new_interface (derived->ns->op[op], target_proc, - p->where) == FAILURE) - return FAILURE; + if (!gfc_check_new_interface (derived->ns->op[op], target_proc, p->where)) + return false; head = derived->ns->op[op]; intr = gfc_get_interface (); intr->sym = target_proc; @@ -11501,20 +11493,20 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, } } - return SUCCESS; + return true; error: p->error = 1; - return FAILURE; + return false; } /* Resolve a type-bound user operator (tree-walker callback). */ static gfc_symbol* resolve_bindings_derived; -static gfc_try resolve_bindings_result; +static bool resolve_bindings_result; -static gfc_try check_uop_procedure (gfc_symbol* sym, locus where); +static bool check_uop_procedure (gfc_symbol* sym, locus where); static void resolve_typebound_user_op (gfc_symtree* stree) @@ -11545,8 +11537,7 @@ resolve_typebound_user_op (gfc_symtree* stree) stree->n.tb->overridden = NULL; /* Resolve basically using worker function. */ - if (resolve_tb_generic_targets (super_type, stree->n.tb, stree->name) - == FAILURE) + if (!resolve_tb_generic_targets (super_type, stree->n.tb, stree->name)) goto error; /* Check the targets to be functions of correct interface. */ @@ -11558,14 +11549,14 @@ resolve_typebound_user_op (gfc_symtree* stree) if (!target_proc) goto error; - if (check_uop_procedure (target_proc, stree->n.tb->where) == FAILURE) + if (!check_uop_procedure (target_proc, stree->n.tb->where)) goto error; } return; error: - resolve_bindings_result = FAILURE; + resolve_bindings_result = false; stree->n.tb->error = 1; } @@ -11593,8 +11584,7 @@ resolve_typebound_procedure (gfc_symtree* stree) /* If this is a GENERIC binding, use that routine. */ if (stree->n.tb->is_generic) { - if (resolve_typebound_generic (resolve_bindings_derived, stree) - == FAILURE) + if (!resolve_typebound_generic (resolve_bindings_derived, stree)) goto error; return; } @@ -11610,7 +11600,7 @@ resolve_typebound_procedure (gfc_symtree* stree) if (stree->n.tb->deferred) { - if (check_proc_interface (proc, &where) == FAILURE) + if (!check_proc_interface (proc, &where)) goto error; } else @@ -11740,7 +11730,7 @@ resolve_typebound_procedure (gfc_symtree* stree) if (overridden->n.tb) stree->n.tb->overridden = overridden->n.tb; - if (gfc_check_typebound_override (stree, overridden) == FAILURE) + if (!gfc_check_typebound_override (stree, overridden)) goto error; } } @@ -11768,26 +11758,26 @@ resolve_typebound_procedure (gfc_symtree* stree) return; error: - resolve_bindings_result = FAILURE; + resolve_bindings_result = false; stree->n.tb->error = 1; } -static gfc_try +static bool resolve_typebound_procedures (gfc_symbol* derived) { int op; gfc_symbol* super_type; if (!derived->f2k_derived || !derived->f2k_derived->tb_sym_root) - return SUCCESS; + return true; super_type = gfc_get_derived_super_type (derived); if (super_type) resolve_symbol (super_type); resolve_bindings_derived = derived; - resolve_bindings_result = SUCCESS; + resolve_bindings_result = true; /* Make sure the vtab has been generated. */ gfc_find_derived_vtab (derived); @@ -11803,9 +11793,9 @@ resolve_typebound_procedures (gfc_symbol* derived) for (op = 0; op != GFC_INTRINSIC_OPS; ++op) { gfc_typebound_proc* p = derived->f2k_derived->tb_op[op]; - if (p && resolve_typebound_intrinsic_op (derived, (gfc_intrinsic_op) op, - p) == FAILURE) - resolve_bindings_result = FAILURE; + if (p && !resolve_typebound_intrinsic_op (derived, + (gfc_intrinsic_op)op, p)) + resolve_bindings_result = false; } return resolve_bindings_result; @@ -11833,37 +11823,37 @@ add_dt_to_dt_list (gfc_symbol *derived) /* Ensure that a derived-type is really not abstract, meaning that every inherited DEFERRED binding is overridden by a non-DEFERRED one. */ -static gfc_try +static bool ensure_not_abstract_walker (gfc_symbol* sub, gfc_symtree* st) { if (!st) - return SUCCESS; + return true; - if (ensure_not_abstract_walker (sub, st->left) == FAILURE) - return FAILURE; - if (ensure_not_abstract_walker (sub, st->right) == FAILURE) - return FAILURE; + if (!ensure_not_abstract_walker (sub, st->left)) + return false; + if (!ensure_not_abstract_walker (sub, st->right)) + return false; if (st->n.tb && st->n.tb->deferred) { gfc_symtree* overriding; overriding = gfc_find_typebound_proc (sub, NULL, st->name, true, NULL); if (!overriding) - return FAILURE; + return false; gcc_assert (overriding->n.tb); if (overriding->n.tb->deferred) { gfc_error ("Derived-type '%s' declared at %L must be ABSTRACT because" " '%s' is DEFERRED and not overridden", sub->name, &sub->declared_at, st->name); - return FAILURE; + return false; } } - return SUCCESS; + return true; } -static gfc_try +static bool ensure_not_abstract (gfc_symbol* sub, gfc_symbol* ancestor) { /* The algorithm used here is to recursively travel up the ancestry of sub @@ -11876,15 +11866,15 @@ ensure_not_abstract (gfc_symbol* sub, gfc_symbol* ancestor) gcc_assert (ancestor && !sub->attr.abstract); if (!ancestor->attr.abstract) - return SUCCESS; + return true; /* Walk bindings of this ancestor. */ if (ancestor->f2k_derived) { - gfc_try t; + bool t; t = ensure_not_abstract_walker (sub, ancestor->f2k_derived->tb_sym_root); - if (t == FAILURE) - return FAILURE; + if (!t) + return false; } /* Find next ancestor type and recurse on it. */ @@ -11892,7 +11882,7 @@ ensure_not_abstract (gfc_symbol* sub, gfc_symbol* ancestor) if (ancestor) return ensure_not_abstract (sub, ancestor); - return SUCCESS; + return true; } @@ -11937,14 +11927,14 @@ check_defined_assignments (gfc_symbol *derived) resolution stage, but can be done as soon as the dt declaration has been parsed. */ -static gfc_try +static bool resolve_fl_derived0 (gfc_symbol *sym) { gfc_symbol* super_type; gfc_component *c; if (sym->attr.unlimited_polymorphic) - return SUCCESS; + return true; super_type = gfc_get_derived_super_type (sym); @@ -11954,19 +11944,19 @@ resolve_fl_derived0 (gfc_symbol *sym) gfc_error ("As extending type '%s' at %L has a coarray component, " "parent type '%s' shall also have one", sym->name, &sym->declared_at, super_type->name); - return FAILURE; + return false; } /* Ensure the extended type gets resolved before we do. */ - if (super_type && resolve_fl_derived0 (super_type) == FAILURE) - return FAILURE; + if (super_type && !resolve_fl_derived0 (super_type)) + return false; /* An ABSTRACT type must be extensible. */ if (sym->attr.abstract && !gfc_type_is_extensible (sym)) { gfc_error ("Non-extensible derived-type '%s' at %L must not be ABSTRACT", sym->name, &sym->declared_at); - return FAILURE; + return false; } c = (sym->attr.is_class) ? sym->components->ts.u.derived->components @@ -11982,7 +11972,7 @@ resolve_fl_derived0 (gfc_symbol *sym) { gfc_error ("Deferred-length character component '%s' at %L is not " "yet supported", c->name, &c->loc); - return FAILURE; + return false; } /* F2008, C442. */ @@ -11992,7 +11982,7 @@ resolve_fl_derived0 (gfc_symbol *sym) { gfc_error ("Coarray component '%s' at %L must be allocatable with " "deferred shape", c->name, &c->loc); - return FAILURE; + return false; } /* F2008, C443. */ @@ -12001,7 +11991,7 @@ resolve_fl_derived0 (gfc_symbol *sym) { gfc_error ("Component '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) " "shall not be a coarray", c->name, &c->loc); - return FAILURE; + return false; } /* F2008, C444. */ @@ -12012,7 +12002,7 @@ resolve_fl_derived0 (gfc_symbol *sym) gfc_error ("Component '%s' at %L with coarray component " "shall be a nonpointer, nonallocatable scalar", c->name, &c->loc); - return FAILURE; + return false; } /* F2008, C448. */ @@ -12020,7 +12010,7 @@ resolve_fl_derived0 (gfc_symbol *sym) { gfc_error ("Component '%s' at %L has the CONTIGUOUS attribute but " "is not an array pointer", c->name, &c->loc); - return FAILURE; + return false; } if (c->attr.proc_pointer && c->ts.interface) @@ -12028,8 +12018,8 @@ resolve_fl_derived0 (gfc_symbol *sym) gfc_symbol *ifc = c->ts.interface; if (!sym->attr.vtype - && check_proc_interface (ifc, &c->loc) == FAILURE) - return FAILURE; + && !check_proc_interface (ifc, &c->loc)) + return false; if (ifc->attr.if_source || ifc->attr.intrinsic) { @@ -12071,8 +12061,8 @@ resolve_fl_derived0 (gfc_symbol *sym) { gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); if (cl->length && !cl->resolved - && gfc_resolve_expr (cl->length) == FAILURE) - return FAILURE; + && !gfc_resolve_expr (cl->length)) + return false; c->ts.u.cl = cl; } } @@ -12115,7 +12105,7 @@ resolve_fl_derived0 (gfc_symbol *sym) "at %L has no argument '%s'", c->name, c->tb->pass_arg, &c->loc, c->tb->pass_arg); c->tb->error = 1; - return FAILURE; + return false; } } else @@ -12129,7 +12119,7 @@ resolve_fl_derived0 (gfc_symbol *sym) "must have at least one argument", c->name, &c->loc); c->tb->error = 1; - return FAILURE; + return false; } me_arg = c->ts.interface->formal->sym; } @@ -12145,7 +12135,7 @@ resolve_fl_derived0 (gfc_symbol *sym) " the derived type '%s'", me_arg->name, c->name, me_arg->name, &c->loc, sym->name); c->tb->error = 1; - return FAILURE; + return false; } /* Check for C453. */ @@ -12155,7 +12145,7 @@ resolve_fl_derived0 (gfc_symbol *sym) "must be scalar", me_arg->name, c->name, me_arg->name, &c->loc); c->tb->error = 1; - return FAILURE; + return false; } if (me_arg->attr.pointer) @@ -12164,7 +12154,7 @@ resolve_fl_derived0 (gfc_symbol *sym) "may not have the POINTER attribute", me_arg->name, c->name, me_arg->name, &c->loc); c->tb->error = 1; - return FAILURE; + return false; } if (me_arg->attr.allocatable) @@ -12173,7 +12163,7 @@ resolve_fl_derived0 (gfc_symbol *sym) "may not be ALLOCATABLE", me_arg->name, c->name, me_arg->name, &c->loc); c->tb->error = 1; - return FAILURE; + return false; } if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS) @@ -12189,8 +12179,8 @@ resolve_fl_derived0 (gfc_symbol *sym) || (!sym->attr.is_class && (!sym->attr.extension || c != sym->components))) && !sym->attr.vtype - && resolve_typespec_used (&c->ts, &c->loc, c->name) == FAILURE) - return FAILURE; + && !resolve_typespec_used (&c->ts, &c->loc, c->name)) + return false; /* If this type is an extension, set the accessibility of the parent component. */ @@ -12209,21 +12199,21 @@ resolve_fl_derived0 (gfc_symbol *sym) gfc_error ("Component '%s' of '%s' at %L has the same name as an" " inherited type-bound procedure", c->name, sym->name, &c->loc); - return FAILURE; + return false; } if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer && !c->ts.deferred) { if (c->ts.u.cl->length == NULL - || (resolve_charlen (c->ts.u.cl) == FAILURE) + || (!resolve_charlen(c->ts.u.cl)) || !gfc_is_constant_expr (c->ts.u.cl->length)) { gfc_error ("Character length of component '%s' needs to " "be a constant specification expression at %L", c->name, c->ts.u.cl->length ? &c->ts.u.cl->length->where : &c->loc); - return FAILURE; + return false; } } @@ -12233,7 +12223,7 @@ resolve_fl_derived0 (gfc_symbol *sym) gfc_error ("Character component '%s' of '%s' at %L with deferred " "length must be a POINTER or ALLOCATABLE", c->name, sym->name, &c->loc); - return FAILURE; + return false; } if (c->ts.type == BT_DERIVED @@ -12242,17 +12232,17 @@ resolve_fl_derived0 (gfc_symbol *sym) && !is_sym_host_assoc (c->ts.u.derived, sym->ns) && !c->ts.u.derived->attr.use_assoc && !gfc_check_symbol_access (c->ts.u.derived) - && gfc_notify_std (GFC_STD_F2003, "the component '%s' " - "is a PRIVATE type and cannot be a component of " - "'%s', which is PUBLIC at %L", c->name, - sym->name, &sym->declared_at) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2003, "the component '%s' is a " + "PRIVATE type and cannot be a component of " + "'%s', which is PUBLIC at %L", c->name, + sym->name, &sym->declared_at)) + return false; if ((sym->attr.sequence || sym->attr.is_bind_c) && c->ts.type == BT_CLASS) { gfc_error ("Polymorphic component %s at %L in SEQUENCE or BIND(C) " "type %s", c->name, &c->loc, sym->name); - return FAILURE; + return false; } if (sym->attr.sequence) @@ -12262,7 +12252,7 @@ resolve_fl_derived0 (gfc_symbol *sym) gfc_error ("Component %s of SEQUENCE type declared at %L does " "not have the SEQUENCE attribute", c->ts.u.derived->name, &sym->declared_at); - return FAILURE; + return false; } } @@ -12280,7 +12270,7 @@ resolve_fl_derived0 (gfc_symbol *sym) gfc_error ("The pointer component '%s' of '%s' at %L is a type " "that has not been declared", c->name, sym->name, &c->loc); - return FAILURE; + return false; } if (c->ts.type == BT_CLASS && c->attr.class_ok @@ -12292,7 +12282,7 @@ resolve_fl_derived0 (gfc_symbol *sym) gfc_error ("The pointer component '%s' of '%s' at %L is a type " "that has not been declared", c->name, sym->name, &c->loc); - return FAILURE; + return false; } /* C437. */ @@ -12305,7 +12295,7 @@ resolve_fl_derived0 (gfc_symbol *sym) "or pointer", c->name, &c->loc); /* Prevent a recurrence of the error. */ c->ts.type = BT_UNKNOWN; - return FAILURE; + return false; } /* Ensure that all the derived type components are put on the @@ -12318,14 +12308,14 @@ resolve_fl_derived0 (gfc_symbol *sym) && sym != c->ts.u.derived) add_dt_to_dt_list (c->ts.u.derived); - if (gfc_resolve_array_spec (c->as, !(c->attr.pointer - || c->attr.proc_pointer - || c->attr.allocatable)) == FAILURE) - return FAILURE; + if (!gfc_resolve_array_spec (c->as, + !(c->attr.pointer || c->attr.proc_pointer + || c->attr.allocatable))) + return false; if (c->initializer && !sym->attr.vtype - && gfc_check_assign_symbol (sym, c, c->initializer) == FAILURE) - return FAILURE; + && !gfc_check_assign_symbol (sym, c, c->initializer)) + return false; } check_defined_assignments (sym); @@ -12338,8 +12328,8 @@ resolve_fl_derived0 (gfc_symbol *sym) all DEFERRED bindings are overridden. */ if (super_type && super_type->attr.abstract && !sym->attr.abstract && !sym->attr.is_class - && ensure_not_abstract (sym, super_type) == FAILURE) - return FAILURE; + && !ensure_not_abstract (sym, super_type)) + return false; /* Add derived type to the derived type list. */ add_dt_to_dt_list (sym); @@ -12348,7 +12338,7 @@ resolve_fl_derived0 (gfc_symbol *sym) finalization wrapper is generated early enough. */ gfc_is_finalizable (sym, NULL); - return SUCCESS; + return true; } @@ -12357,34 +12347,34 @@ resolve_fl_derived0 (gfc_symbol *sym) to 'resolve_fl_derived0' this can only be done after the module has been parsed completely. */ -static gfc_try +static bool resolve_fl_derived (gfc_symbol *sym) { gfc_symbol *gen_dt = NULL; if (sym->attr.unlimited_polymorphic) - return SUCCESS; + return true; if (!sym->attr.is_class) gfc_find_symbol (sym->name, sym->ns, 0, &gen_dt); if (gen_dt && gen_dt->generic && gen_dt->generic->next && (!gen_dt->generic->sym->attr.use_assoc || gen_dt->generic->sym->module != gen_dt->generic->next->sym->module) - && gfc_notify_std (GFC_STD_F2003, "Generic name '%s' of " - "function '%s' at %L being the same name as derived " - "type at %L", sym->name, - gen_dt->generic->sym == sym - ? gen_dt->generic->next->sym->name - : gen_dt->generic->sym->name, - gen_dt->generic->sym == sym - ? &gen_dt->generic->next->sym->declared_at - : &gen_dt->generic->sym->declared_at, - &sym->declared_at) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2003, "Generic name '%s' of function " + "'%s' at %L being the same name as derived " + "type at %L", sym->name, + gen_dt->generic->sym == sym + ? gen_dt->generic->next->sym->name + : gen_dt->generic->sym->name, + gen_dt->generic->sym == sym + ? &gen_dt->generic->next->sym->declared_at + : &gen_dt->generic->sym->declared_at, + &sym->declared_at)) + return false; /* Resolve the finalizer procedures. */ - if (gfc_resolve_finalizers (sym) == FAILURE) - return FAILURE; + if (!gfc_resolve_finalizers (sym)) + return false; if (sym->attr.is_class && sym->ts.u.derived == NULL) { @@ -12394,7 +12384,7 @@ resolve_fl_derived (gfc_symbol *sym) /* Nothing more to do for unlimited polymorphic entities. */ if (data->ts.u.derived->attr.unlimited_polymorphic) - return SUCCESS; + return true; else if (vptr->ts.u.derived == NULL) { gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived); @@ -12403,18 +12393,18 @@ resolve_fl_derived (gfc_symbol *sym) } } - if (resolve_fl_derived0 (sym) == FAILURE) - return FAILURE; + if (!resolve_fl_derived0 (sym)) + return false; /* Resolve the type-bound procedures. */ - if (resolve_typebound_procedures (sym) == FAILURE) - return FAILURE; + if (!resolve_typebound_procedures (sym)) + return false; - return SUCCESS; + return true; } -static gfc_try +static bool resolve_fl_namelist (gfc_symbol *sym) { gfc_namelist *nl; @@ -12428,31 +12418,29 @@ resolve_fl_namelist (gfc_symbol *sym) { gfc_error ("Assumed size array '%s' in namelist '%s' at %L is not " "allowed", nl->sym->name, sym->name, &sym->declared_at); - return FAILURE; + return false; } if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE - && gfc_notify_std (GFC_STD_F2003, "NAMELIST array " - "object '%s' with assumed shape in namelist " - "'%s' at %L", nl->sym->name, sym->name, - &sym->declared_at) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' " + "with assumed shape in namelist '%s' at %L", + nl->sym->name, sym->name, &sym->declared_at)) + return false; if (is_non_constant_shape_array (nl->sym) - && gfc_notify_std (GFC_STD_F2003, "NAMELIST array " - "object '%s' with nonconstant shape in namelist " - "'%s' at %L", nl->sym->name, sym->name, - &sym->declared_at) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' " + "with nonconstant shape in namelist '%s' at %L", + nl->sym->name, sym->name, &sym->declared_at)) + return false; if (nl->sym->ts.type == BT_CHARACTER && (nl->sym->ts.u.cl->length == NULL || !gfc_is_constant_expr (nl->sym->ts.u.cl->length)) - && gfc_notify_std (GFC_STD_F2003, "NAMELIST object " - "'%s' with nonconstant character length in " - "namelist '%s' at %L", nl->sym->name, sym->name, - &sym->declared_at) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F2003, "NAMELIST object '%s' with " + "nonconstant character length in " + "namelist '%s' at %L", nl->sym->name, + sym->name, &sym->declared_at)) + return false; /* FIXME: Once UDDTIO is implemented, the following can be removed. */ @@ -12461,18 +12449,18 @@ resolve_fl_namelist (gfc_symbol *sym) gfc_error ("NAMELIST object '%s' in namelist '%s' at %L is " "polymorphic and requires a defined input/output " "procedure", nl->sym->name, sym->name, &sym->declared_at); - return FAILURE; + return false; } if (nl->sym->ts.type == BT_DERIVED && (nl->sym->ts.u.derived->attr.alloc_comp || nl->sym->ts.u.derived->attr.pointer_comp)) { - if (gfc_notify_std (GFC_STD_F2003, "NAMELIST object " - "'%s' in namelist '%s' at %L with ALLOCATABLE " - "or POINTER components", nl->sym->name, - sym->name, &sym->declared_at) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2003, "NAMELIST object '%s' in " + "namelist '%s' at %L with ALLOCATABLE " + "or POINTER components", nl->sym->name, + sym->name, &sym->declared_at)) + return false; /* FIXME: Once UDDTIO is implemented, the following can be removed. */ @@ -12480,7 +12468,7 @@ resolve_fl_namelist (gfc_symbol *sym) "ALLOCATABLE or POINTER components and thus requires " "a defined input/output procedure", nl->sym->name, sym->name, &sym->declared_at); - return FAILURE; + return false; } } @@ -12496,7 +12484,7 @@ resolve_fl_namelist (gfc_symbol *sym) gfc_error ("NAMELIST object '%s' was declared PRIVATE and " "cannot be member of PUBLIC namelist '%s' at %L", nl->sym->name, sym->name, &sym->declared_at); - return FAILURE; + return false; } /* Types with private components that came here by USE-association. */ @@ -12506,7 +12494,7 @@ resolve_fl_namelist (gfc_symbol *sym) gfc_error ("NAMELIST object '%s' has use-associated PRIVATE " "components and cannot be member of namelist '%s' at %L", nl->sym->name, sym->name, &sym->declared_at); - return FAILURE; + return false; } /* Types with private components that are defined in the same module. */ @@ -12517,7 +12505,7 @@ resolve_fl_namelist (gfc_symbol *sym) gfc_error ("NAMELIST object '%s' has PRIVATE components and " "cannot be a member of PUBLIC namelist '%s' at %L", nl->sym->name, sym->name, &sym->declared_at); - return FAILURE; + return false; } } } @@ -12544,15 +12532,15 @@ resolve_fl_namelist (gfc_symbol *sym) gfc_error ("PROCEDURE attribute conflicts with NAMELIST " "attribute in '%s' at %L", nlsym->name, &sym->declared_at); - return FAILURE; + return false; } } - return SUCCESS; + return true; } -static gfc_try +static bool resolve_fl_parameter (gfc_symbol *sym) { /* A parameter array's shape needs to be constant. */ @@ -12562,7 +12550,7 @@ resolve_fl_parameter (gfc_symbol *sym) { gfc_error ("Parameter array '%s' at %L cannot be automatic " "or of deferred shape", sym->name, &sym->declared_at); - return FAILURE; + return false; } /* Make sure a parameter that has been implicitly typed still @@ -12574,7 +12562,7 @@ resolve_fl_parameter (gfc_symbol *sym) { gfc_error ("Implicitly typed PARAMETER '%s' at %L doesn't match a " "later IMPLICIT type", sym->name, &sym->declared_at); - return FAILURE; + return false; } /* Make sure the types of derived parameters are consistent. This @@ -12585,9 +12573,9 @@ resolve_fl_parameter (gfc_symbol *sym) { gfc_error ("Incompatible derived type in PARAMETER at %L", &sym->value->where); - return FAILURE; + return false; } - return SUCCESS; + return true; } @@ -12659,7 +12647,7 @@ resolve_symbol (gfc_symbol *sym) gfc_add_function (&sym->attr, sym->name, &sym->declared_at); if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL - && resolve_procedure_interface (sym) == FAILURE) + && !resolve_procedure_interface (sym)) return; if (sym->attr.is_protected && !sym->attr.proc_pointer @@ -12675,7 +12663,7 @@ resolve_symbol (gfc_symbol *sym) return; } - if (sym->attr.flavor == FL_DERIVED && resolve_fl_derived (sym) == FAILURE) + if (sym->attr.flavor == FL_DERIVED && !resolve_fl_derived (sym)) return; /* Symbols that are module procedures with results (functions) have @@ -12689,7 +12677,7 @@ resolve_symbol (gfc_symbol *sym) representation. This needs to be done before assigning a default type to avoid spurious warnings. */ if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic - && gfc_resolve_intrinsic (sym, &sym->declared_at) == FAILURE) + && !gfc_resolve_intrinsic (sym, &sym->declared_at)) return; /* Resolve associate names. */ @@ -12897,7 +12885,7 @@ resolve_symbol (gfc_symbol *sym) sym->attr.use_assoc == 0 && sym->attr.dummy == 0 && sym->attr.flavor != FL_PROCEDURE && sym->attr.flavor != FL_DERIVED) { - gfc_try t = SUCCESS; + bool t = true; /* First, make sure the variable is declared at the module-level scope (J3/04-007, Section 15.3). */ @@ -12907,7 +12895,7 @@ resolve_symbol (gfc_symbol *sym) gfc_error ("Variable '%s' at %L cannot be BIND(C) because it " "is neither a COMMON block nor declared at the " "module level scope", sym->name, &(sym->declared_at)); - t = FAILURE; + t = false; } else if (sym->common_head != NULL) { @@ -12926,7 +12914,7 @@ resolve_symbol (gfc_symbol *sym) of that type are declared. */ if (sym->ts.u.derived->attr.is_bind_c != 1) verify_bind_c_derived_type (sym->ts.u.derived); - t = FAILURE; + t = false; } /* Verify the variable itself as C interoperable if it @@ -12937,7 +12925,7 @@ resolve_symbol (gfc_symbol *sym) sym->common_block); } - if (t == FAILURE) + if (!t) { /* clear the is_bind_c flag to prevent reporting errors more than once if something failed. */ @@ -12972,7 +12960,7 @@ resolve_symbol (gfc_symbol *sym) && sym->ts.u.derived->attr.use_assoc && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE - && resolve_fl_derived (sym->ts.u.derived) == FAILURE) + && !resolve_fl_derived (sym->ts.u.derived)) return; /* Unless the derived-type declaration is use associated, Fortran 95 @@ -12984,11 +12972,12 @@ resolve_symbol (gfc_symbol *sym) && !sym->ts.u.derived->attr.use_assoc && gfc_check_symbol_access (sym) && !gfc_check_symbol_access (sym->ts.u.derived) - && gfc_notify_std (GFC_STD_F2003, "PUBLIC %s '%s' at %L " - "of PRIVATE derived type '%s'", - (sym->attr.flavor == FL_PARAMETER) ? "parameter" - : "variable", sym->name, &sym->declared_at, - sym->ts.u.derived->name) == FAILURE) + && !gfc_notify_std (GFC_STD_F2003, "PUBLIC %s '%s' at %L of PRIVATE " + "derived type '%s'", + (sym->attr.flavor == FL_PARAMETER) + ? "parameter" : "variable", + sym->name, &sym->declared_at, + sym->ts.u.derived->name)) return; /* F2008, C1302. */ @@ -13128,41 +13117,40 @@ resolve_symbol (gfc_symbol *sym) if (gfc_logical_kinds[i].kind == sym->ts.kind) break; if (!gfc_logical_kinds[i].c_bool && sym->attr.dummy - && gfc_notify_std (GFC_STD_GNU, "LOGICAL dummy argument '%s' at %L " - "with non-C_Bool kind in BIND(C) procedure '%s'", - sym->name, &sym->declared_at, - sym->ns->proc_name->name) == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, "LOGICAL dummy argument '%s' at " + "%L with non-C_Bool kind in BIND(C) procedure " + "'%s'", sym->name, &sym->declared_at, + sym->ns->proc_name->name)) return; else if (!gfc_logical_kinds[i].c_bool - && gfc_notify_std (GFC_STD_GNU, "LOGICAL result variable '%s' at" - " %L with non-C_Bool kind in BIND(C) " - "procedure '%s'", sym->name, - &sym->declared_at, - sym->attr.function ? sym->name - : sym->ns->proc_name->name) - == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, "LOGICAL result variable " + "'%s' at %L with non-C_Bool kind in " + "BIND(C) procedure '%s'", sym->name, + &sym->declared_at, + sym->attr.function ? sym->name + : sym->ns->proc_name->name)) return; } switch (sym->attr.flavor) { case FL_VARIABLE: - if (resolve_fl_variable (sym, mp_flag) == FAILURE) + if (!resolve_fl_variable (sym, mp_flag)) return; break; case FL_PROCEDURE: - if (resolve_fl_procedure (sym, mp_flag) == FAILURE) + if (!resolve_fl_procedure (sym, mp_flag)) return; break; case FL_NAMELIST: - if (resolve_fl_namelist (sym) == FAILURE) + if (!resolve_fl_namelist (sym)) return; break; case FL_PARAMETER: - if (resolve_fl_parameter (sym) == FAILURE) + if (!resolve_fl_parameter (sym)) return; break; @@ -13243,8 +13231,7 @@ resolve_symbol (gfc_symbol *sym) /* If this symbol has a type-spec, check it. */ if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER || (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)) - if (resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name) - == FAILURE) + if (!resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name)) return; } @@ -13261,30 +13248,30 @@ values; /* Advance the values structure to point to the next value in the data list. */ -static gfc_try +static bool next_data_value (void) { while (mpz_cmp_ui (values.left, 0) == 0) { if (values.vnode->next == NULL) - return FAILURE; + return false; values.vnode = values.vnode->next; mpz_set (values.left, values.vnode->repeat); } - return SUCCESS; + return true; } -static gfc_try +static bool check_data_variable (gfc_data_variable *var, locus *where) { gfc_expr *e; mpz_t size; mpz_t offset; - gfc_try t; + bool t; ar_type mark = AR_UNKNOWN; int i; mpz_t section_index[GFC_MAX_DIMENSIONS]; @@ -13293,8 +13280,8 @@ check_data_variable (gfc_data_variable *var, locus *where) gfc_symbol *sym; int has_pointer; - if (gfc_resolve_expr (var->expr) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (var->expr)) + return false; ar = NULL; mpz_init_set_si (offset, 0); @@ -13315,7 +13302,7 @@ check_data_variable (gfc_data_variable *var, locus *where) { gfc_error ("DATA array '%s' at %L must be specified in a previous" " declaration", sym->name, where); - return FAILURE; + return false; } has_pointer = sym->attr.pointer; @@ -13324,7 +13311,7 @@ check_data_variable (gfc_data_variable *var, locus *where) { gfc_error ("DATA element '%s' at %L cannot have a coindex", sym->name, where); - return FAILURE; + return false; } for (ref = e->ref; ref; ref = ref->next) @@ -13338,7 +13325,7 @@ check_data_variable (gfc_data_variable *var, locus *where) { gfc_error ("DATA element '%s' at %L is a pointer and so must " "be a full array", sym->name, where); - return FAILURE; + return false; } } @@ -13380,29 +13367,29 @@ check_data_variable (gfc_data_variable *var, locus *where) gcc_unreachable (); } - if (gfc_array_size (e, &size) == FAILURE) + if (!gfc_array_size (e, &size)) { gfc_error ("Nonconstant array section at %L in DATA statement", &e->where); mpz_clear (offset); - return FAILURE; + return false; } } - t = SUCCESS; + t = true; while (mpz_cmp_ui (size, 0) > 0) { - if (next_data_value () == FAILURE) + if (!next_data_value ()) { gfc_error ("DATA statement at %L has more variables than values", where); - t = FAILURE; + t = false; break; } t = gfc_check_assign (var->expr, values.vnode->expr, 0); - if (t == FAILURE) + if (!t) break; /* If we have more than one element left in the repeat count, @@ -13434,7 +13421,7 @@ check_data_variable (gfc_data_variable *var, locus *where) mpz_add (offset, offset, range); mpz_clear (range); - if (t == FAILURE) + if (!t) break; } @@ -13446,7 +13433,7 @@ check_data_variable (gfc_data_variable *var, locus *where) t = gfc_assign_data_value (var->expr, values.vnode->expr, offset, NULL); - if (t == FAILURE) + if (!t) break; if (mark == AR_FULL) @@ -13472,17 +13459,17 @@ check_data_variable (gfc_data_variable *var, locus *where) } -static gfc_try traverse_data_var (gfc_data_variable *, locus *); +static bool traverse_data_var (gfc_data_variable *, locus *); /* Iterate over a list of elements in a DATA statement. */ -static gfc_try +static bool traverse_data_list (gfc_data_variable *var, locus *where) { mpz_t trip; iterator_stack frame; gfc_expr *e, *start, *end, *step; - gfc_try retval = SUCCESS; + bool retval = true; mpz_init (frame.value); mpz_init (trip); @@ -13491,28 +13478,28 @@ traverse_data_list (gfc_data_variable *var, locus *where) end = gfc_copy_expr (var->iter.end); step = gfc_copy_expr (var->iter.step); - if (gfc_simplify_expr (start, 1) == FAILURE + if (!gfc_simplify_expr (start, 1) || start->expr_type != EXPR_CONSTANT) { gfc_error ("start of implied-do loop at %L could not be " "simplified to a constant value", &start->where); - retval = FAILURE; + retval = false; goto cleanup; } - if (gfc_simplify_expr (end, 1) == FAILURE + if (!gfc_simplify_expr (end, 1) || end->expr_type != EXPR_CONSTANT) { gfc_error ("end of implied-do loop at %L could not be " "simplified to a constant value", &start->where); - retval = FAILURE; + retval = false; goto cleanup; } - if (gfc_simplify_expr (step, 1) == FAILURE + if (!gfc_simplify_expr (step, 1) || step->expr_type != EXPR_CONSTANT) { gfc_error ("step of implied-do loop at %L could not be " "simplified to a constant value", &start->where); - retval = FAILURE; + retval = false; goto cleanup; } @@ -13530,17 +13517,17 @@ traverse_data_list (gfc_data_variable *var, locus *where) while (mpz_cmp_ui (trip, 0) > 0) { - if (traverse_data_var (var->list, where) == FAILURE) + if (!traverse_data_var (var->list, where)) { - retval = FAILURE; + retval = false; goto cleanup; } e = gfc_copy_expr (var->expr); - if (gfc_simplify_expr (e, 1) == FAILURE) + if (!gfc_simplify_expr (e, 1)) { gfc_free_expr (e); - retval = FAILURE; + retval = false; goto cleanup; } @@ -13564,10 +13551,10 @@ cleanup: /* Type resolve variables in the variable list of a DATA statement. */ -static gfc_try +static bool traverse_data_var (gfc_data_variable *var, locus *where) { - gfc_try t; + bool t; for (; var; var = var->next) { @@ -13576,11 +13563,11 @@ traverse_data_var (gfc_data_variable *var, locus *where) else t = check_data_variable (var, where); - if (t == FAILURE) - return FAILURE; + if (!t) + return false; } - return SUCCESS; + return true; } @@ -13588,27 +13575,27 @@ traverse_data_var (gfc_data_variable *var, locus *where) This is separate from the assignment checking because data lists should only be resolved once. */ -static gfc_try +static bool resolve_data_variables (gfc_data_variable *d) { for (; d; d = d->next) { if (d->list == NULL) { - if (gfc_resolve_expr (d->expr) == FAILURE) - return FAILURE; + if (!gfc_resolve_expr (d->expr)) + return false; } else { - if (gfc_resolve_iterator (&d->iter, false, true) == FAILURE) - return FAILURE; + if (!gfc_resolve_iterator (&d->iter, false, true)) + return false; - if (resolve_data_variables (d->list) == FAILURE) - return FAILURE; + if (!resolve_data_variables (d->list)) + return false; } } - return SUCCESS; + return true; } @@ -13620,7 +13607,7 @@ static void resolve_data (gfc_data *d) { - if (resolve_data_variables (d->var) == FAILURE) + if (!resolve_data_variables (d->var)) return; values.vnode = d->value; @@ -13629,12 +13616,12 @@ resolve_data (gfc_data *d) else mpz_set (values.left, d->value->repeat); - if (traverse_data_var (d->var, &d->where) == FAILURE) + if (!traverse_data_var (d->var, &d->where)) return; /* At this point, we better not have any values left. */ - if (next_data_value () == SUCCESS) + if (next_data_value ()) gfc_error ("DATA statement at %L has more values than variables", &d->where); } @@ -13851,13 +13838,13 @@ sequence_type (gfc_typespec ts) /* Resolve derived type EQUIVALENCE object. */ -static gfc_try +static bool resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) { gfc_component *c = derived->components; if (!derived) - return SUCCESS; + return true; /* Shall not be an object of nonsequence derived type. */ if (!derived->attr.sequence) @@ -13865,7 +13852,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) gfc_error ("Derived type variable '%s' at %L must have SEQUENCE " "attribute to be an EQUIVALENCE object", sym->name, &e->where); - return FAILURE; + return false; } /* Shall not have allocatable components. */ @@ -13874,7 +13861,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) gfc_error ("Derived type variable '%s' at %L cannot have ALLOCATABLE " "components to be an EQUIVALENCE object",sym->name, &e->where); - return FAILURE; + return false; } if (sym->attr.in_common && gfc_has_default_initializer (sym->ts.u.derived)) @@ -13882,14 +13869,14 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) gfc_error ("Derived type variable '%s' at %L with default " "initialization cannot be in EQUIVALENCE with a variable " "in COMMON", sym->name, &e->where); - return FAILURE; + return false; } for (; c ; c = c->next) { if (c->ts.type == BT_DERIVED - && (resolve_equivalence_derived (c->ts.u.derived, sym, e) == FAILURE)) - return FAILURE; + && (!resolve_equivalence_derived(c->ts.u.derived, sym, e))) + return false; /* Shall not be an object of sequence derived type containing a pointer in the structure. */ @@ -13898,10 +13885,10 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) gfc_error ("Derived type variable '%s' at %L with pointer " "component(s) cannot be an EQUIVALENCE object", sym->name, &e->where); - return FAILURE; + return false; } } - return SUCCESS; + return true; } @@ -14004,7 +13991,7 @@ resolve_equivalence (gfc_equiv *eq) } } - if (gfc_resolve_expr (e) == FAILURE) + if (!gfc_resolve_expr (e)) continue; sym = e->symtree->n.sym; @@ -14040,7 +14027,7 @@ resolve_equivalence (gfc_equiv *eq) } if (e->ts.type == BT_DERIVED - && resolve_equivalence_derived (e->ts.u.derived, sym, e) == FAILURE) + && !resolve_equivalence_derived (e->ts.u.derived, sym, e)) continue; /* Check that the types correspond correctly: @@ -14068,38 +14055,32 @@ resolve_equivalence (gfc_equiv *eq) "statement at %L with different type objects"; if ((object ==2 && last_eq_type == SEQ_MIXED - && gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, last_where) - == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, last_where)) || (eq_type == SEQ_MIXED - && gfc_notify_std (GFC_STD_GNU, msg, sym->name, - &e->where) == FAILURE)) + && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where))) continue; msg = "Non-default type object or sequence %s in EQUIVALENCE " "statement at %L with objects of different type"; if ((object ==2 && last_eq_type == SEQ_NONDEFAULT - && gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, - last_where) == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, last_where)) || (eq_type == SEQ_NONDEFAULT - && gfc_notify_std (GFC_STD_GNU, msg, sym->name, - &e->where) == FAILURE)) + && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where))) continue; msg ="Non-CHARACTER object '%s' in default CHARACTER " "EQUIVALENCE statement at %L"; if (last_eq_type == SEQ_CHARACTER && eq_type != SEQ_CHARACTER - && gfc_notify_std (GFC_STD_GNU, msg, sym->name, - &e->where) == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)) continue; msg ="Non-NUMERIC object '%s' in default NUMERIC " "EQUIVALENCE statement at %L"; if (last_eq_type == SEQ_NUMERIC && eq_type != SEQ_NUMERIC - && gfc_notify_std (GFC_STD_GNU, msg, sym->name, - &e->where) == FAILURE) + && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)) continue; identical_types: @@ -14111,7 +14092,7 @@ resolve_equivalence (gfc_equiv *eq) /* Shall not be an automatic array. */ if (e->ref->type == REF_ARRAY - && gfc_resolve_array_spec (e->ref->u.ar.as, 1) == FAILURE) + && !gfc_resolve_array_spec (e->ref->u.ar.as, 1)) { gfc_error ("Array '%s' at %L with non-constant bounds cannot be " "an EQUIVALENCE object", sym->name, &e->where); @@ -14165,7 +14146,7 @@ resolve_fntype (gfc_namespace *ns) sym = ns->proc_name; if (sym->result == sym && sym->ts.type == BT_UNKNOWN - && gfc_set_default_type (sym, 0, NULL) == FAILURE + && !gfc_set_default_type (sym, 0, NULL) && !sym->attr.untyped) { gfc_error ("Function '%s' at %L has no IMPLICIT type", @@ -14188,7 +14169,7 @@ resolve_fntype (gfc_namespace *ns) { if (el->sym->result == el->sym && el->sym->ts.type == BT_UNKNOWN - && gfc_set_default_type (el->sym, 0, NULL) == FAILURE + && !gfc_set_default_type (el->sym, 0, NULL) && !el->sym->attr.untyped) { gfc_error ("ENTRY '%s' at %L has no IMPLICIT type", @@ -14201,7 +14182,7 @@ resolve_fntype (gfc_namespace *ns) /* 12.3.2.1.1 Defined operators. */ -static gfc_try +static bool check_uop_procedure (gfc_symbol *sym, locus where) { gfc_formal_arglist *formal; @@ -14210,7 +14191,7 @@ check_uop_procedure (gfc_symbol *sym, locus where) { gfc_error ("User operator procedure '%s' at %L must be a FUNCTION", sym->name, &where); - return FAILURE; + return false; } if (sym->ts.type == BT_CHARACTER @@ -14220,7 +14201,7 @@ check_uop_procedure (gfc_symbol *sym, locus where) { gfc_error ("User operator procedure '%s' at %L cannot be assumed " "character length", sym->name, &where); - return FAILURE; + return false; } formal = gfc_sym_get_dummy_args (sym); @@ -14228,49 +14209,49 @@ check_uop_procedure (gfc_symbol *sym, locus where) { gfc_error ("User operator procedure '%s' at %L must have at least " "one argument", sym->name, &where); - return FAILURE; + return false; } if (formal->sym->attr.intent != INTENT_IN) { gfc_error ("First argument of operator interface at %L must be " "INTENT(IN)", &where); - return FAILURE; + return false; } if (formal->sym->attr.optional) { gfc_error ("First argument of operator interface at %L cannot be " "optional", &where); - return FAILURE; + return false; } formal = formal->next; if (!formal || !formal->sym) - return SUCCESS; + return true; if (formal->sym->attr.intent != INTENT_IN) { gfc_error ("Second argument of operator interface at %L must be " "INTENT(IN)", &where); - return FAILURE; + return false; } if (formal->sym->attr.optional) { gfc_error ("Second argument of operator interface at %L cannot be " "optional", &where); - return FAILURE; + return false; } if (formal->next) { gfc_error ("Operator interface at %L must have, at most, two " "arguments", &where); - return FAILURE; + return false; } - return SUCCESS; + return true; } static void @@ -14310,9 +14291,8 @@ resolve_types (gfc_namespace *ns) unsigned letter; for (letter = 0; letter != GFC_LETTERS; ++letter) if (ns->set_flag[letter] - && resolve_typespec_used (&ns->default_type[letter], - &ns->implicit_loc[letter], - NULL) == FAILURE) + && !resolve_typespec_used (&ns->default_type[letter], + &ns->implicit_loc[letter], NULL)) return; } diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index f714ed0..fd8f284 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -326,7 +326,7 @@ add_path_to_list (gfc_directorylist **list, const char *path, q = (char *) alloca (len + 1); memcpy (q, p, len + 1); i = len - 1; - while (i >=0 && IS_DIR_SEPARATOR(q[i])) + while (i >=0 && IS_DIR_SEPARATOR (q[i])) q[i--] = '\0'; if (stat (q, &st)) @@ -1123,7 +1123,7 @@ restart: else gfc_advance_line (); - if (gfc_at_eof()) + if (gfc_at_eof ()) goto not_continuation; /* We've got a continuation line. If we are on the very next line after @@ -1831,7 +1831,7 @@ preprocessor_line (gfc_char_t *c) } -static gfc_try load_file (const char *, const char *, bool); +static bool load_file (const char *, const char *, bool); /* include_line()-- Checks a line buffer to see if it is an include line. If so, we call load_file() recursively to load the included @@ -1902,7 +1902,7 @@ include_line (gfc_char_t *line) read by anything else. */ filename = gfc_widechar_to_char (begin, -1); - if (load_file (filename, NULL, false) == FAILURE) + if (!load_file (filename, NULL, false)) exit (FATAL_EXIT_CODE); free (filename); @@ -1912,7 +1912,7 @@ include_line (gfc_char_t *line) /* Load a file into memory by calling load_line until the file ends. */ -static gfc_try +static bool load_file (const char *realfilename, const char *displayedname, bool initial) { gfc_char_t *line; @@ -1936,7 +1936,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) fprintf (stderr, "%s:%d: Error: File '%s' is being included " "recursively\n", current_file->filename, current_file->line, filename); - return FAILURE; + return false; } if (initial) @@ -1951,7 +1951,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) if (input == NULL) { gfc_error_now ("Can't open file '%s'", filename); - return FAILURE; + return false; } } else @@ -1961,7 +1961,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) { fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n", current_file->filename, current_file->line, filename); - return FAILURE; + return false; } } @@ -2096,19 +2096,19 @@ load_file (const char *realfilename, const char *displayedname, bool initial) add_file_change (NULL, current_file->inclusion_line + 1); current_file = current_file->up; linemap_add (line_table, LC_LEAVE, 0, NULL, 0); - return SUCCESS; + return true; } -/* Open a new file and start scanning from that file. Returns SUCCESS - if everything went OK, FAILURE otherwise. If form == FORM_UNKNOWN +/* Open a new file and start scanning from that file. Returns true + if everything went OK, false otherwise. If form == FORM_UNKNOWN it tries to determine the source form from the filename, defaulting to free form. */ -gfc_try +bool gfc_new_file (void) { - gfc_try result; + bool result; if (gfc_cpp_enabled ()) { diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index e24cfcf..5dcbf02 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3263,7 +3263,7 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper, gcc_assert (array->expr_type == EXPR_VARIABLE); gcc_assert (as); - if (gfc_resolve_array_spec (as, 0) == FAILURE) + if (!gfc_resolve_array_spec (as, 0)) return NULL; /* The last dimension of an assumed-size array is special. */ @@ -3313,8 +3313,7 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper, { if (upper) { - if (gfc_ref_dimen_size (&ref->u.ar, d-1, &result->value.integer, NULL) - != SUCCESS) + if (!gfc_ref_dimen_size (&ref->u.ar, d - 1, &result->value.integer, NULL)) goto returnNull; } else @@ -4078,7 +4077,7 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign) case BT_CHARACTER: #define LENGTH(x) ((x)->value.character.length) #define STRING(x) ((x)->value.character.string) - if (LENGTH(extremum) < LENGTH(arg)) + if (LENGTH (extremum) < LENGTH(arg)) { gfc_char_t *tmp = STRING(extremum); @@ -4629,10 +4628,10 @@ gfc_simplify_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector) gfc_expr *result; gfc_constructor *array_ctor, *mask_ctor, *vector_ctor; - if (!is_constant_array_expr(array) - || !is_constant_array_expr(vector) + if (!is_constant_array_expr (array) + || !is_constant_array_expr (vector) || (!gfc_is_constant_expr (mask) - && !is_constant_array_expr(mask))) + && !is_constant_array_expr (mask))) return NULL; result = gfc_get_array_expr (array->ts.type, array->ts.kind, &array->where); @@ -5506,7 +5505,7 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind) gfc_expr *result, *e, *f; gfc_array_ref *ar; int n; - gfc_try t; + bool t; int k = get_kind (BT_INTEGER, kind, "SHAPE", gfc_default_integer_kind); if (source->rank == -1) @@ -5524,7 +5523,7 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind) } else if (source->shape) { - t = SUCCESS; + t = true; for (n = 0; n < source->rank; n++) { mpz_init (shape[n]); @@ -5532,13 +5531,13 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind) } } else - t = FAILURE; + t = false; for (n = 0; n < source->rank; n++) { e = gfc_get_constant_expr (BT_INTEGER, k, &source->where); - if (t == SUCCESS) + if (t) { mpz_set (e->value.integer, shape[n]); mpz_clear (shape[n]); @@ -5631,7 +5630,7 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) if (dim == NULL) { - if (gfc_array_size (array, &size) == FAILURE) + if (!gfc_array_size (array, &size)) return NULL; } else @@ -5640,7 +5639,7 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) return NULL; d = mpz_get_ui (dim->value.integer) - 1; - if (gfc_array_dimen_size (array, d, &size) == FAILURE) + if (!gfc_array_dimen_size (array, d, &size)) return NULL; } @@ -5668,7 +5667,7 @@ gfc_simplify_sizeof (gfc_expr *x) return NULL; if (x->rank && x->expr_type != EXPR_ARRAY - && gfc_array_size (x, &array_size) == FAILURE) + && !gfc_array_size (x, &array_size)) return NULL; result = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, @@ -5897,7 +5896,7 @@ gfc_simplify_spread (gfc_expr *source, gfc_expr *dim_expr, gfc_expr *ncopies_exp constructor. */ if (source->expr_type == EXPR_ARRAY) { - if (gfc_array_size (source, &size) == FAILURE) + if (!gfc_array_size (source, &size)) gfc_internal_error ("Failure getting length of a constant array."); } else @@ -6123,13 +6122,13 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) || !gfc_is_constant_expr (size)) return NULL; - if (gfc_calculate_transfer_sizes (source, mold, size, &source_size, - &result_size, &result_length) == FAILURE) + if (!gfc_calculate_transfer_sizes (source, mold, size, &source_size, + &result_size, &result_length)) return NULL; /* Calculate the size of the source. */ if (source->expr_type == EXPR_ARRAY - && gfc_array_size (source, &tmp) == FAILURE) + && !gfc_array_size (source, &tmp)) gfc_internal_error ("Failure getting length of a constant array."); /* Create an empty new expression with the appropriate characteristics. */ @@ -6395,7 +6394,7 @@ gfc_simplify_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field) if (!is_constant_array_expr (vector) || !is_constant_array_expr (mask) || (!gfc_is_constant_expr (field) - && !is_constant_array_expr(field))) + && !is_constant_array_expr (field))) return NULL; result = gfc_get_array_expr (vector->ts.type, vector->ts.kind, diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 6fc5812..c72974d 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -148,7 +148,7 @@ gfc_clear_new_implicit (void) /* Prepare for a new implicit range. Sets flags in new_flag[]. */ -gfc_try +bool gfc_add_new_implicit_range (int c1, int c2) { int i; @@ -162,20 +162,20 @@ gfc_add_new_implicit_range (int c1, int c2) { gfc_error ("Letter '%c' already set in IMPLICIT statement at %C", i + 'A'); - return FAILURE; + return false; } new_flag[i] = 1; } - return SUCCESS; + return true; } /* Add a matched implicit range for gfc_set_implicit(). Check if merging the new implicit types back into the existing types will work. */ -gfc_try +bool gfc_merge_new_implicit (gfc_typespec *ts) { int i; @@ -183,7 +183,7 @@ gfc_merge_new_implicit (gfc_typespec *ts) if (gfc_current_ns->seen_implicit_none) { gfc_error ("Cannot specify IMPLICIT at %C after IMPLICIT NONE"); - return FAILURE; + return false; } for (i = 0; i < GFC_LETTERS; i++) @@ -194,7 +194,7 @@ gfc_merge_new_implicit (gfc_typespec *ts) { gfc_error ("Letter %c already has an IMPLICIT type at %C", i + 'A'); - return FAILURE; + return false; } gfc_current_ns->default_type[i] = *ts; @@ -202,7 +202,7 @@ gfc_merge_new_implicit (gfc_typespec *ts) gfc_current_ns->set_flag[i] = 1; } } - return SUCCESS; + return true; } @@ -234,7 +234,7 @@ gfc_get_default_type (const char *name, gfc_namespace *ns) letter of its name. Fails if the letter in question has no default type. */ -gfc_try +bool gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) { gfc_typespec *ts; @@ -253,7 +253,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) sym->attr.untyped = 1; /* Ensure we only give an error once. */ } - return FAILURE; + return false; } sym->ts = *ts; @@ -262,9 +262,8 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) if (ts->type == BT_CHARACTER && ts->u.cl) sym->ts.u.cl = gfc_new_charlen (sym->ns, ts->u.cl); else if (ts->type == BT_CLASS - && gfc_build_class_symbol (&sym->ts, &sym->attr, - &sym->as, false) == FAILURE) - return FAILURE; + && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false)) + return false; if (sym->attr.is_bind_c == 1 && gfc_option.warn_c_binding_type) { @@ -293,7 +292,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) } } - return SUCCESS; + return true; } @@ -311,8 +310,7 @@ gfc_check_function_type (gfc_namespace *ns) if (proc->result->ts.type == BT_UNKNOWN && proc->result->ts.interface == NULL) { - if (gfc_set_default_type (proc->result, 0, gfc_current_ns) - == SUCCESS) + if (gfc_set_default_type (proc->result, 0, gfc_current_ns)) { if (proc->result != proc) { @@ -348,7 +346,7 @@ gfc_check_function_type (gfc_namespace *ns) goto conflict_std;\ } -static gfc_try +static bool check_conflict (symbol_attribute *attr, const char *name, locus *where) { static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER", @@ -416,7 +414,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) gfc_error ("%s attribute not allowed in BLOCK DATA program unit at %L", a1, where); - return FAILURE; + return false; } } @@ -440,7 +438,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) case FL_NAMELIST: gfc_error ("Namelist group name at %L cannot have the " "SAVE attribute", where); - return FAILURE; + return false; break; case FL_PROCEDURE: /* Conflicts between SAVE and PROCEDURE will be checked at @@ -471,9 +469,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) if ((attr->if_source == IFSRC_DECL && !attr->procedure) || attr->contained) conf (external, subroutine); - if (attr->proc_pointer && gfc_notify_std (GFC_STD_F2003, - "Procedure pointer at %C") == FAILURE) - return FAILURE; + if (attr->proc_pointer && !gfc_notify_std (GFC_STD_F2003, + "Procedure pointer at %C")) + return false; conf (allocatable, pointer); conf_std (allocatable, dummy, GFC_STD_F2003); @@ -636,13 +634,13 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) a2 = attr->access == ACCESS_PUBLIC ? publik : privat; gfc_error ("%s attribute applied to %s %s at %L", a2, a1, name, where); - return FAILURE; + return false; } if (attr->is_bind_c) { gfc_error_now ("BIND(C) applied to %s %s at %L", a1, name, where); - return FAILURE; + return false; } break; @@ -748,7 +746,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) break; } - return SUCCESS; + return true; conflict: if (name == NULL) @@ -758,7 +756,7 @@ conflict: gfc_error ("%s attribute conflicts with %s attribute in '%s' at %L", a1, a2, name, where); - return FAILURE; + return false; conflict_std: if (name == NULL) @@ -836,47 +834,47 @@ duplicate_attr (const char *attr, locus *where) } -gfc_try +bool gfc_add_ext_attribute (symbol_attribute *attr, ext_attr_id_t ext_attr, locus *where ATTRIBUTE_UNUSED) { attr->ext_attr |= 1 << ext_attr; - return SUCCESS; + return true; } /* Called from decl.c (attr_decl1) to check attributes, when declared separately. */ -gfc_try +bool gfc_add_attribute (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; return check_conflict (attr, NULL, where); } -gfc_try +bool gfc_add_allocatable (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->allocatable) { duplicate_attr ("ALLOCATABLE", where); - return FAILURE; + return false; } if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY - && gfc_find_state (COMP_INTERFACE) == FAILURE) + && !gfc_find_state (COMP_INTERFACE)) { gfc_error ("ALLOCATABLE specified outside of INTERFACE body at %L", where); - return FAILURE; + return false; } attr->allocatable = 1; @@ -884,25 +882,25 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; if (attr->codimension) { duplicate_attr ("CODIMENSION", where); - return FAILURE; + return false; } if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY - && gfc_find_state (COMP_INTERFACE) == FAILURE) + && !gfc_find_state (COMP_INTERFACE)) { gfc_error ("CODIMENSION specified for '%s' outside its INTERFACE body " "at %L", name, where); - return FAILURE; + return false; } attr->codimension = 1; @@ -910,25 +908,25 @@ gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; if (attr->dimension) { duplicate_attr ("DIMENSION", where); - return FAILURE; + return false; } if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY - && gfc_find_state (COMP_INTERFACE) == FAILURE) + && !gfc_find_state (COMP_INTERFACE)) { gfc_error ("DIMENSION specified for '%s' outside its INTERFACE body " "at %L", name, where); - return FAILURE; + return false; } attr->dimension = 1; @@ -936,29 +934,29 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_contiguous (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; attr->contiguous = 1; return check_conflict (attr, name, where); } -gfc_try +bool gfc_add_external (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->external) { duplicate_attr ("EXTERNAL", where); - return FAILURE; + return false; } if (attr->pointer && attr->if_source != IFSRC_IFBODY) @@ -973,17 +971,17 @@ gfc_add_external (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_intrinsic (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->intrinsic) { duplicate_attr ("INTRINSIC", where); - return FAILURE; + return false; } attr->intrinsic = 1; @@ -992,17 +990,17 @@ gfc_add_intrinsic (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_optional (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->optional) { duplicate_attr ("OPTIONAL", where); - return FAILURE; + return false; } attr->optional = 1; @@ -1010,23 +1008,23 @@ gfc_add_optional (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_pointer (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->pointer && !(attr->if_source == IFSRC_IFBODY - && gfc_find_state (COMP_INTERFACE) == FAILURE)) + && !gfc_find_state (COMP_INTERFACE))) { duplicate_attr ("POINTER", where); - return FAILURE; + return false; } if (attr->procedure || (attr->external && attr->if_source != IFSRC_IFBODY) || (attr->if_source == IFSRC_IFBODY - && gfc_find_state (COMP_INTERFACE) == FAILURE)) + && !gfc_find_state (COMP_INTERFACE))) attr->proc_pointer = 1; else attr->pointer = 1; @@ -1035,30 +1033,30 @@ gfc_add_pointer (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_cray_pointer (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; attr->cray_pointer = 1; return check_conflict (attr, NULL, where); } -gfc_try +bool gfc_add_cray_pointee (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->cray_pointee) { gfc_error ("Cray Pointee at %L appears in multiple pointer()" " statements", where); - return FAILURE; + return false; } attr->cray_pointee = 1; @@ -1066,19 +1064,18 @@ gfc_add_cray_pointee (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_protected (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; if (attr->is_protected) { - if (gfc_notify_std (GFC_STD_LEGACY, - "Duplicate PROTECTED attribute specified at %L", - where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, + "Duplicate PROTECTED attribute specified at %L", + where)) + return false; } attr->is_protected = 1; @@ -1086,32 +1083,32 @@ gfc_add_protected (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_result (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; attr->result = 1; return check_conflict (attr, name, where); } -gfc_try +bool gfc_add_save (symbol_attribute *attr, save_state s, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; if (s == SAVE_EXPLICIT && gfc_pure (NULL)) { gfc_error ("SAVE attribute at %L cannot be specified in a PURE procedure", where); - return FAILURE; + return false; } if (s == SAVE_EXPLICIT && gfc_implicit_pure (NULL)) @@ -1119,11 +1116,10 @@ gfc_add_save (symbol_attribute *attr, save_state s, const char *name, if (s == SAVE_EXPLICIT && attr->save == SAVE_EXPLICIT) { - if (gfc_notify_std (GFC_STD_LEGACY, - "Duplicate SAVE attribute specified at %L", - where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, + "Duplicate SAVE attribute specified at %L", + where)) + return false; } attr->save = s; @@ -1131,20 +1127,19 @@ gfc_add_save (symbol_attribute *attr, save_state s, const char *name, } -gfc_try +bool gfc_add_value (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; if (attr->value) { - if (gfc_notify_std (GFC_STD_LEGACY, - "Duplicate VALUE attribute specified at %L", - where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, + "Duplicate VALUE attribute specified at %L", + where)) + return false; } attr->value = 1; @@ -1152,7 +1147,7 @@ gfc_add_value (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where) { /* No check_used needed as 11.2.1 of the F2003 standard allows @@ -1160,10 +1155,10 @@ gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where) given a VOLATILE attribute - unless it is a coarray (F2008, C560). */ if (attr->volatile_ && attr->volatile_ns == gfc_current_ns) - if (gfc_notify_std (GFC_STD_LEGACY, - "Duplicate VOLATILE attribute specified at %L", where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, + "Duplicate VOLATILE attribute specified at %L", + where)) + return false; attr->volatile_ = 1; attr->volatile_ns = gfc_current_ns; @@ -1171,7 +1166,7 @@ gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where) { /* No check_used needed as 11.2.1 of the F2003 standard allows @@ -1179,10 +1174,10 @@ gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where) given a ASYNCHRONOUS attribute. */ if (attr->asynchronous && attr->asynchronous_ns == gfc_current_ns) - if (gfc_notify_std (GFC_STD_LEGACY, - "Duplicate ASYNCHRONOUS attribute specified at %L", - where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_LEGACY, + "Duplicate ASYNCHRONOUS attribute specified at %L", + where)) + return false; attr->asynchronous = 1; attr->asynchronous_ns = gfc_current_ns; @@ -1190,17 +1185,17 @@ gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; if (attr->threadprivate) { duplicate_attr ("THREADPRIVATE", where); - return FAILURE; + return false; } attr->threadprivate = 1; @@ -1208,17 +1203,17 @@ gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_target (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->target) { duplicate_attr ("TARGET", where); - return FAILURE; + return false; } attr->target = 1; @@ -1226,12 +1221,12 @@ gfc_add_target (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; /* Duplicate dummy arguments are allowed due to ENTRY statements. */ attr->dummy = 1; @@ -1239,12 +1234,12 @@ gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; /* Duplicate attribute already checked for. */ attr->in_common = 1; @@ -1252,35 +1247,35 @@ gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_in_equivalence (symbol_attribute *attr, const char *name, locus *where) { /* Duplicate attribute already checked for. */ attr->in_equivalence = 1; - if (check_conflict (attr, name, where) == FAILURE) - return FAILURE; + if (!check_conflict (attr, name, where)) + return false; if (attr->flavor == FL_VARIABLE) - return SUCCESS; + return true; return gfc_add_flavor (attr, FL_VARIABLE, name, where); } -gfc_try +bool gfc_add_data (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; attr->data = 1; return check_conflict (attr, name, where); } -gfc_try +bool gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where) { @@ -1289,29 +1284,29 @@ gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_sequence (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; attr->sequence = 1; return check_conflict (attr, name, where); } -gfc_try +bool gfc_add_elemental (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->elemental) { duplicate_attr ("ELEMENTAL", where); - return FAILURE; + return false; } attr->elemental = 1; @@ -1319,17 +1314,17 @@ gfc_add_elemental (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_pure (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->pure) { duplicate_attr ("PURE", where); - return FAILURE; + return false; } attr->pure = 1; @@ -1337,17 +1332,17 @@ gfc_add_pure (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_recursive (symbol_attribute *attr, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->recursive) { duplicate_attr ("RECURSIVE", where); - return FAILURE; + return false; } attr->recursive = 1; @@ -1355,17 +1350,17 @@ gfc_add_recursive (symbol_attribute *attr, locus *where) } -gfc_try +bool gfc_add_entry (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; if (attr->entry) { duplicate_attr ("ENTRY", where); - return FAILURE; + return false; } attr->entry = 1; @@ -1373,60 +1368,60 @@ gfc_add_entry (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_function (symbol_attribute *attr, const char *name, locus *where) { if (attr->flavor != FL_PROCEDURE - && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE) - return FAILURE; + && !gfc_add_flavor (attr, FL_PROCEDURE, name, where)) + return false; attr->function = 1; return check_conflict (attr, name, where); } -gfc_try +bool gfc_add_subroutine (symbol_attribute *attr, const char *name, locus *where) { if (attr->flavor != FL_PROCEDURE - && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE) - return FAILURE; + && !gfc_add_flavor (attr, FL_PROCEDURE, name, where)) + return false; attr->subroutine = 1; return check_conflict (attr, name, where); } -gfc_try +bool gfc_add_generic (symbol_attribute *attr, const char *name, locus *where) { if (attr->flavor != FL_PROCEDURE - && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE) - return FAILURE; + && !gfc_add_flavor (attr, FL_PROCEDURE, name, where)) + return false; attr->generic = 1; return check_conflict (attr, name, where); } -gfc_try +bool gfc_add_proc (symbol_attribute *attr, const char *name, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->flavor != FL_PROCEDURE - && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE) - return FAILURE; + && !gfc_add_flavor (attr, FL_PROCEDURE, name, where)) + return false; if (attr->procedure) { duplicate_attr ("PROCEDURE", where); - return FAILURE; + return false; } attr->procedure = 1; @@ -1435,24 +1430,24 @@ gfc_add_proc (symbol_attribute *attr, const char *name, locus *where) } -gfc_try +bool gfc_add_abstract (symbol_attribute* attr, locus* where) { if (attr->abstract) { duplicate_attr ("ABSTRACT", where); - return FAILURE; + return false; } attr->abstract = 1; - return SUCCESS; + return true; } /* Flavors are special because some flavors are not what Fortran considers attributes and can be reaffirmed multiple times. */ -gfc_try +bool gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name, locus *where) { @@ -1460,10 +1455,10 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name, if ((f == FL_PROGRAM || f == FL_BLOCK_DATA || f == FL_MODULE || f == FL_PARAMETER || f == FL_LABEL || f == FL_DERIVED || f == FL_NAMELIST) && check_used (attr, name, where)) - return FAILURE; + return false; if (attr->flavor == f && f == FL_VARIABLE) - return SUCCESS; + return true; if (attr->flavor != FL_UNKNOWN) { @@ -1479,7 +1474,7 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name, gfc_code2string (flavors, attr->flavor), gfc_code2string (flavors, f), where); - return FAILURE; + return false; } attr->flavor = f; @@ -1488,17 +1483,17 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name, } -gfc_try +bool gfc_add_procedure (symbol_attribute *attr, procedure_type t, const char *name, locus *where) { if (check_used (attr, name, where)) - return FAILURE; + return false; if (attr->flavor != FL_PROCEDURE - && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE) - return FAILURE; + && !gfc_add_flavor (attr, FL_PROCEDURE, name, where)) + return false; if (where == NULL) where = &gfc_current_locus; @@ -1509,27 +1504,27 @@ gfc_add_procedure (symbol_attribute *attr, procedure_type t, gfc_code2string (procedures, t), where, gfc_code2string (procedures, attr->proc)); - return FAILURE; + return false; } attr->proc = t; /* Statement functions are always scalar and functions. */ if (t == PROC_ST_FUNCTION - && ((!attr->function && gfc_add_function (attr, name, where) == FAILURE) + && ((!attr->function && !gfc_add_function (attr, name, where)) || attr->dimension)) - return FAILURE; + return false; return check_conflict (attr, name, where); } -gfc_try +bool gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where) { if (check_used (attr, NULL, where)) - return FAILURE; + return false; if (attr->intent == INTENT_UNKNOWN) { @@ -1544,13 +1539,13 @@ gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where) gfc_intent_string (attr->intent), gfc_intent_string (intent), where); - return FAILURE; + return false; } /* No checks for use-association in public and private statements. */ -gfc_try +bool gfc_add_access (symbol_attribute *attr, gfc_access access, const char *name, locus *where) { @@ -1566,13 +1561,13 @@ gfc_add_access (symbol_attribute *attr, gfc_access access, where = &gfc_current_locus; gfc_error ("ACCESS specification at %L was already specified", where); - return FAILURE; + return false; } /* Set the is_bind_c field for the given symbol_attribute. */ -gfc_try +bool gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where, int is_proc_lang_bind_spec) { @@ -1588,9 +1583,8 @@ gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where, if (where == NULL) where = &gfc_current_locus; - if (gfc_notify_std (GFC_STD_F2003, "BIND(C) at %L", where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2003, "BIND(C) at %L", where)) + return false; return check_conflict (attr, name, where); } @@ -1598,7 +1592,7 @@ gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where, /* Set the extension field for the given symbol_attribute. */ -gfc_try +bool gfc_add_extension (symbol_attribute *attr, locus *where) { if (where == NULL) @@ -1609,21 +1603,20 @@ gfc_add_extension (symbol_attribute *attr, locus *where) else attr->extension = 1; - if (gfc_notify_std (GFC_STD_F2003, "EXTENDS at %L", where) - == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_F2003, "EXTENDS at %L", where)) + return false; - return SUCCESS; + return true; } -gfc_try +bool gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source, gfc_formal_arglist * formal, locus *where) { if (check_used (&sym->attr, sym->name, where)) - return FAILURE; + return false; if (where == NULL) where = &gfc_current_locus; @@ -1633,26 +1626,26 @@ gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source, { gfc_error ("Symbol '%s' at %L already has an explicit interface", sym->name, where); - return FAILURE; + return false; } if (source == IFSRC_IFBODY && (sym->attr.dimension || sym->attr.allocatable)) { gfc_error ("'%s' at %L has attributes specified outside its INTERFACE " "body", sym->name, where); - return FAILURE; + return false; } sym->formal = formal; sym->attr.if_source = source; - return SUCCESS; + return true; } /* Add a type to a symbol. */ -gfc_try +bool gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) { sym_flavor flavor; @@ -1678,14 +1671,14 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) else gfc_error ("Symbol '%s' at %L already has basic type of %s", sym->name, where, gfc_basic_typename (type)); - return FAILURE; + return false; } if (sym->attr.procedure && sym->ts.interface) { gfc_error ("Procedure '%s' at %L may not have basic type of %s", sym->name, where, gfc_basic_typename (ts->type)); - return FAILURE; + return false; } flavor = sym->attr.flavor; @@ -1696,11 +1689,11 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) || flavor == FL_DERIVED || flavor == FL_NAMELIST) { gfc_error ("Symbol '%s' at %L cannot have a type", sym->name, where); - return FAILURE; + return false; } sym->ts = *ts; - return SUCCESS; + return true; } @@ -1716,12 +1709,12 @@ gfc_clear_attr (symbol_attribute *attr) /* Check for missing attributes in the new symbol. Currently does nothing, but it's not clear that it is unnecessary yet. */ -gfc_try +bool gfc_missing_attr (symbol_attribute *attr ATTRIBUTE_UNUSED, locus *where ATTRIBUTE_UNUSED) { - return SUCCESS; + return true; } @@ -1729,7 +1722,7 @@ gfc_missing_attr (symbol_attribute *attr ATTRIBUTE_UNUSED, attributes have a lot of side-effects but cannot be present given where we are called from, so we ignore some bits. */ -gfc_try +bool gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) { int is_proc_lang_bind_spec; @@ -1738,105 +1731,104 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) them; cf. also PR 41034. */ dest->ext_attr |= src->ext_attr; - if (src->allocatable && gfc_add_allocatable (dest, where) == FAILURE) + if (src->allocatable && !gfc_add_allocatable (dest, where)) goto fail; - if (src->dimension && gfc_add_dimension (dest, NULL, where) == FAILURE) + if (src->dimension && !gfc_add_dimension (dest, NULL, where)) goto fail; - if (src->codimension && gfc_add_codimension (dest, NULL, where) == FAILURE) + if (src->codimension && !gfc_add_codimension (dest, NULL, where)) goto fail; - if (src->contiguous && gfc_add_contiguous (dest, NULL, where) == FAILURE) + if (src->contiguous && !gfc_add_contiguous (dest, NULL, where)) goto fail; - if (src->optional && gfc_add_optional (dest, where) == FAILURE) + if (src->optional && !gfc_add_optional (dest, where)) goto fail; - if (src->pointer && gfc_add_pointer (dest, where) == FAILURE) + if (src->pointer && !gfc_add_pointer (dest, where)) goto fail; - if (src->is_protected && gfc_add_protected (dest, NULL, where) == FAILURE) + if (src->is_protected && !gfc_add_protected (dest, NULL, where)) goto fail; - if (src->save && gfc_add_save (dest, src->save, NULL, where) == FAILURE) + if (src->save && !gfc_add_save (dest, src->save, NULL, where)) goto fail; - if (src->value && gfc_add_value (dest, NULL, where) == FAILURE) + if (src->value && !gfc_add_value (dest, NULL, where)) goto fail; - if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE) + if (src->volatile_ && !gfc_add_volatile (dest, NULL, where)) goto fail; - if (src->asynchronous && gfc_add_asynchronous (dest, NULL, where) == FAILURE) + if (src->asynchronous && !gfc_add_asynchronous (dest, NULL, where)) goto fail; if (src->threadprivate - && gfc_add_threadprivate (dest, NULL, where) == FAILURE) + && !gfc_add_threadprivate (dest, NULL, where)) goto fail; - if (src->target && gfc_add_target (dest, where) == FAILURE) + if (src->target && !gfc_add_target (dest, where)) goto fail; - if (src->dummy && gfc_add_dummy (dest, NULL, where) == FAILURE) + if (src->dummy && !gfc_add_dummy (dest, NULL, where)) goto fail; - if (src->result && gfc_add_result (dest, NULL, where) == FAILURE) + if (src->result && !gfc_add_result (dest, NULL, where)) goto fail; if (src->entry) dest->entry = 1; - if (src->in_namelist && gfc_add_in_namelist (dest, NULL, where) == FAILURE) + if (src->in_namelist && !gfc_add_in_namelist (dest, NULL, where)) goto fail; - if (src->in_common && gfc_add_in_common (dest, NULL, where) == FAILURE) + if (src->in_common && !gfc_add_in_common (dest, NULL, where)) goto fail; - if (src->generic && gfc_add_generic (dest, NULL, where) == FAILURE) + if (src->generic && !gfc_add_generic (dest, NULL, where)) goto fail; - if (src->function && gfc_add_function (dest, NULL, where) == FAILURE) + if (src->function && !gfc_add_function (dest, NULL, where)) goto fail; - if (src->subroutine && gfc_add_subroutine (dest, NULL, where) == FAILURE) + if (src->subroutine && !gfc_add_subroutine (dest, NULL, where)) goto fail; - if (src->sequence && gfc_add_sequence (dest, NULL, where) == FAILURE) + if (src->sequence && !gfc_add_sequence (dest, NULL, where)) goto fail; - if (src->elemental && gfc_add_elemental (dest, where) == FAILURE) + if (src->elemental && !gfc_add_elemental (dest, where)) goto fail; - if (src->pure && gfc_add_pure (dest, where) == FAILURE) + if (src->pure && !gfc_add_pure (dest, where)) goto fail; - if (src->recursive && gfc_add_recursive (dest, where) == FAILURE) + if (src->recursive && !gfc_add_recursive (dest, where)) goto fail; if (src->flavor != FL_UNKNOWN - && gfc_add_flavor (dest, src->flavor, NULL, where) == FAILURE) + && !gfc_add_flavor (dest, src->flavor, NULL, where)) goto fail; if (src->intent != INTENT_UNKNOWN - && gfc_add_intent (dest, src->intent, where) == FAILURE) + && !gfc_add_intent (dest, src->intent, where)) goto fail; if (src->access != ACCESS_UNKNOWN - && gfc_add_access (dest, src->access, NULL, where) == FAILURE) + && !gfc_add_access (dest, src->access, NULL, where)) goto fail; - if (gfc_missing_attr (dest, where) == FAILURE) + if (!gfc_missing_attr (dest, where)) goto fail; - if (src->cray_pointer && gfc_add_cray_pointer (dest, where) == FAILURE) + if (src->cray_pointer && !gfc_add_cray_pointer (dest, where)) goto fail; - if (src->cray_pointee && gfc_add_cray_pointee (dest, where) == FAILURE) + if (src->cray_pointee && !gfc_add_cray_pointee (dest, where)) goto fail; is_proc_lang_bind_spec = (src->flavor == FL_PROCEDURE ? 1 : 0); if (src->is_bind_c - && gfc_add_is_bind_c (dest, NULL, where, is_proc_lang_bind_spec) - != SUCCESS) - return FAILURE; + && !gfc_add_is_bind_c (dest, NULL, where, is_proc_lang_bind_spec)) + return false; if (src->is_c_interop) dest->is_c_interop = 1; if (src->is_iso_c) dest->is_iso_c = 1; - if (src->external && gfc_add_external (dest, where) == FAILURE) + if (src->external && !gfc_add_external (dest, where)) goto fail; - if (src->intrinsic && gfc_add_intrinsic (dest, where) == FAILURE) + if (src->intrinsic && !gfc_add_intrinsic (dest, where)) goto fail; if (src->proc_pointer) dest->proc_pointer = 1; - return SUCCESS; + return true; fail: - return FAILURE; + return false; } @@ -1852,7 +1844,7 @@ fail: already present. On success, the component pointer is modified to point to the additional component structure. */ -gfc_try +bool gfc_add_component (gfc_symbol *sym, const char *name, gfc_component **component) { @@ -1866,7 +1858,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, { gfc_error ("Component '%s' at %C already declared at %L", name, &p->loc); - return FAILURE; + return false; } tail = p; @@ -1877,7 +1869,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, { gfc_error ("Component '%s' at %C already in the parent type " "at %L", name, &sym->components->ts.u.derived->declared_at); - return FAILURE; + return false; } /* Allocate a new component. */ @@ -1893,7 +1885,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, p->ts.type = BT_UNKNOWN; *component = p; - return SUCCESS; + return true; } @@ -2214,9 +2206,9 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus) lp->defined = type; if (lp->referenced == ST_LABEL_DO_TARGET && type != ST_LABEL_DO_TARGET - && gfc_notify_std (GFC_STD_F95_OBS, "DO termination statement " - "which is not END DO or CONTINUE with label " - "%d at %C", labelno) == FAILURE) + && !gfc_notify_std (GFC_STD_F95_OBS, "DO termination statement " + "which is not END DO or CONTINUE with " + "label %d at %C", labelno)) return; break; @@ -2230,18 +2222,18 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus) /* Reference a label. Given a label and its type, see if that reference is consistent with what is known about that label, - updating the unknown state. Returns FAILURE if something goes + updating the unknown state. Returns false if something goes wrong. */ -gfc_try +bool gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type) { gfc_sl_type label_type; int labelno; - gfc_try rc; + bool rc; if (lp == NULL) - return SUCCESS; + return true; labelno = lp->value; @@ -2257,7 +2249,7 @@ gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type) && (type == ST_LABEL_TARGET || type == ST_LABEL_DO_TARGET)) { gfc_error ("Label %d at %C previously used as a FORMAT label", labelno); - rc = FAILURE; + rc = false; goto done; } @@ -2266,18 +2258,18 @@ gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type) && type == ST_LABEL_FORMAT) { gfc_error ("Label %d at %C previously used as branch target", labelno); - rc = FAILURE; + rc = false; goto done; } if (lp->referenced == ST_LABEL_DO_TARGET && type == ST_LABEL_DO_TARGET - && gfc_notify_std (GFC_STD_F95_OBS, "Shared DO termination label %d " - "at %C", labelno) == FAILURE) - return FAILURE; + && !gfc_notify_std (GFC_STD_F95_OBS, "Shared DO termination label %d " + "at %C", labelno)) + return false; if (lp->referenced != ST_LABEL_DO_TARGET) lp->referenced = type; - rc = SUCCESS; + rc = true; done: return rc; @@ -3773,12 +3765,12 @@ get_iso_c_binding_dt (int sym_id) for such. If an error occurs, the errors are reported here, allowing for multiple errors to be handled for a single derived type. */ -gfc_try +bool verify_bind_c_derived_type (gfc_symbol *derived_sym) { gfc_component *curr_comp = NULL; - gfc_try is_c_interop = FAILURE; - gfc_try retval = SUCCESS; + bool is_c_interop = false; + bool retval = true; if (derived_sym == NULL) gfc_internal_error ("verify_bind_c_derived_type(): Given symbol is " @@ -3787,7 +3779,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) /* If we've already looked at this derived symbol, do not look at it again so we don't repeat warnings/errors. */ if (derived_sym->ts.is_c_interop) - return SUCCESS; + return true; /* The derived type must have the BIND attribute to be interoperable J3/04-007, Section 15.2.3. */ @@ -3797,7 +3789,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) gfc_error_now ("Derived type '%s' declared at %L must have the BIND " "attribute to be C interoperable", derived_sym->name, &(derived_sym->declared_at)); - retval = FAILURE; + retval = false; } curr_comp = derived_sym->components; @@ -3817,7 +3809,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) derived_sym->name, &(derived_sym->declared_at)); derived_sym->ts.is_c_interop = 1; derived_sym->attr.is_bind_c = 1; - return SUCCESS; + return true; } @@ -3838,7 +3830,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) "of the BIND(C) derived type '%s' at %L", curr_comp->name, &(curr_comp->loc), derived_sym->name, &(derived_sym->declared_at)); - retval = FAILURE; + retval = false; } if (curr_comp->attr.proc_pointer != 0) @@ -3847,7 +3839,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) " of the BIND(C) derived type '%s' at %L", curr_comp->name, &curr_comp->loc, derived_sym->name, &derived_sym->declared_at); - retval = FAILURE; + retval = false; } /* The components cannot be allocatable. @@ -3859,7 +3851,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) "of the BIND(C) derived type '%s' at %L", curr_comp->name, &(curr_comp->loc), derived_sym->name, &(derived_sym->declared_at)); - retval = FAILURE; + retval = false; } /* BIND(C) derived types must have interoperable components. */ @@ -3878,7 +3870,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) /* Grab the typespec for the given component and test the kind. */ is_c_interop = gfc_verify_c_interop (&(curr_comp->ts)); - if (is_c_interop != SUCCESS) + if (!is_c_interop) { /* Report warning and continue since not fatal. The draft does specify a constraint that requires all fields @@ -3919,7 +3911,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) gfc_error ("Derived type '%s' at %L cannot be declared with both " "PRIVATE and BIND(C) attributes", derived_sym->name, &(derived_sym->declared_at)); - retval = FAILURE; + retval = false; } if (derived_sym->attr.sequence != 0) @@ -3927,13 +3919,13 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) gfc_error ("Derived type '%s' at %L cannot have the SEQUENCE " "attribute because it is BIND(C)", derived_sym->name, &(derived_sym->declared_at)); - retval = FAILURE; + retval = false; } /* Mark the derived type as not being C interoperable if we found an error. If there were only warnings, proceed with the assumption it's interoperable. */ - if (retval == FAILURE) + if (!retval) derived_sym->ts.is_c_interop = 0; return retval; @@ -3942,7 +3934,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) /* Generate symbols for the named constants c_null_ptr and c_null_funptr. */ -static gfc_try +static bool gen_special_c_interop_ptr (gfc_symbol *tmp_sym, gfc_symtree *dt_symtree) { gfc_constructor *c; @@ -3971,7 +3963,7 @@ gen_special_c_interop_ptr (gfc_symbol *tmp_sym, gfc_symtree *dt_symtree) c->expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0); c->expr->ts.is_iso_c = 1; - return SUCCESS; + return true; } @@ -4292,13 +4284,11 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, tmp_sym->generic = intr; if (!tmp_sym->attr.generic - && gfc_add_generic (&tmp_sym->attr, tmp_sym->name, NULL) - == FAILURE) + && !gfc_add_generic (&tmp_sym->attr, tmp_sym->name, NULL)) return NULL; if (!tmp_sym->attr.function - && gfc_add_function (&tmp_sym->attr, tmp_sym->name, NULL) - == FAILURE) + && !gfc_add_function (&tmp_sym->attr, tmp_sym->name, NULL)) return NULL; } @@ -4375,34 +4365,33 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, /* Check that a symbol is already typed. If strict is not set, an untyped symbol is acceptable for non-standard-conforming mode. */ -gfc_try +bool gfc_check_symbol_typed (gfc_symbol* sym, gfc_namespace* ns, bool strict, locus where) { gcc_assert (sym); if (gfc_matching_prefix) - return SUCCESS; + return true; /* Check for the type and try to give it an implicit one. */ if (sym->ts.type == BT_UNKNOWN - && gfc_set_default_type (sym, 0, ns) == FAILURE) + && !gfc_set_default_type (sym, 0, ns)) { if (strict) { gfc_error ("Symbol '%s' is used before it is typed at %L", sym->name, &where); - return FAILURE; + return false; } - if (gfc_notify_std (GFC_STD_GNU, - "Symbol '%s' is used before" - " it is typed at %L", sym->name, &where) == FAILURE) - return FAILURE; + if (!gfc_notify_std (GFC_STD_GNU, "Symbol '%s' is used before" + " it is typed at %L", sym->name, &where)) + return false; } /* Everything is ok. */ - return SUCCESS; + return true; } diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 75fed2f..05de50d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7582,7 +7582,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, comp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), comp, tmp, NULL_TREE); - if (GFC_DESCRIPTOR_TYPE_P(TREE_TYPE (comp))) + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) tmp = gfc_trans_dealloc_allocated (comp, CLASS_DATA (c)->attr.codimension); else @@ -7647,7 +7647,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tmp = CLASS_DATA (c)->backend_decl; comp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), comp, tmp, NULL_TREE); - if (GFC_DESCRIPTOR_TYPE_P(TREE_TYPE (comp))) + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); else { diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 9b2cc19..2a16059c 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2192,9 +2192,9 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr) minmax (a1, a2, a3, ...) { mvar = a1; - if (a2 .op. mvar || isnan(mvar)) + if (a2 .op. mvar || isnan (mvar)) mvar = a2; - if (a3 .op. mvar || isnan(mvar)) + if (a3 .op. mvar || isnan (mvar)) mvar = a3; ... return mvar @@ -2749,7 +2749,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, if (norm2) { - /* if (x(i) != 0.0) + /* if (x (i) != 0.0) { absX = abs(x(i)) if (absX > scale) @@ -3104,7 +3104,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) else { mpz_t asize; - if (gfc_array_size (arrayexpr, &asize) == SUCCESS) + if (gfc_array_size (arrayexpr, &asize)) { nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind); mpz_clear (asize); @@ -3594,7 +3594,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) else { mpz_t asize; - if (gfc_array_size (arrayexpr, &asize) == SUCCESS) + if (gfc_array_size (arrayexpr, &asize)) { nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind); mpz_clear (asize); diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 988dea9..882927e 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -500,7 +500,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) tree decl, backend_decl, stmt, type, outer_decl; locus old_loc = gfc_current_locus; const char *iname; - gfc_try t; + bool t; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; @@ -562,7 +562,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) ref->u.ar.type = AR_FULL; ref->u.ar.dimen = 0; t = gfc_resolve_expr (e1); - gcc_assert (t == SUCCESS); + gcc_assert (t); e2 = gfc_get_expr (); e2->expr_type = EXPR_VARIABLE; @@ -570,12 +570,12 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) e2->symtree = symtree2; e2->ts = sym->ts; t = gfc_resolve_expr (e2); - gcc_assert (t == SUCCESS); + gcc_assert (t); e3 = gfc_copy_expr (e1); e3->symtree = symtree3; t = gfc_resolve_expr (e3); - gcc_assert (t == SUCCESS); + gcc_assert (t); iname = NULL; switch (OMP_CLAUSE_REDUCTION_CODE (c)) @@ -647,7 +647,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) e1 = gfc_copy_expr (e1); e3 = gfc_copy_expr (e3); t = gfc_resolve_expr (e4); - gcc_assert (t == SUCCESS); + gcc_assert (t); /* Create the init statement list. */ pushlevel (); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 430b10e..1b65f2c 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -2661,7 +2661,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) return need_temp; new_symtree = NULL; - if (find_forall_index (c->expr1, lsym, 2) == SUCCESS) + if (find_forall_index (c->expr1, lsym, 2)) { forall_make_variable_temp (c, pre, post); need_temp = 0; @@ -4757,21 +4757,21 @@ gfc_trans_where (gfc_code * code) are the same. In short, this is VERY conservative and this is needed because the two loops, required by the standard are coalesced in gfc_trans_where_3. */ - if (!gfc_check_dependency(cblock->next->expr1, + if (!gfc_check_dependency (cblock->next->expr1, cblock->expr1, 0) - && !gfc_check_dependency(eblock->next->expr1, + && !gfc_check_dependency (eblock->next->expr1, cblock->expr1, 0) - && !gfc_check_dependency(cblock->next->expr1, + && !gfc_check_dependency (cblock->next->expr1, eblock->next->expr2, 1) - && !gfc_check_dependency(eblock->next->expr1, + && !gfc_check_dependency (eblock->next->expr1, cblock->next->expr2, 1) - && !gfc_check_dependency(cblock->next->expr1, + && !gfc_check_dependency (cblock->next->expr1, cblock->next->expr2, 1) - && !gfc_check_dependency(eblock->next->expr1, + && !gfc_check_dependency (eblock->next->expr1, eblock->next->expr2, 1) - && !gfc_check_dependency(cblock->next->expr1, + && !gfc_check_dependency (cblock->next->expr1, eblock->next->expr1, 0) - && !gfc_check_dependency(eblock->next->expr1, + && !gfc_check_dependency (eblock->next->expr1, cblock->next->expr1, 0)) return gfc_trans_where_3 (cblock, eblock); } diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 4f4c058..379fe94 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -132,7 +132,7 @@ int gfc_numeric_storage_size; int gfc_character_storage_size; -gfc_try +bool gfc_check_any_c_kind (gfc_typespec *ts) { int i; @@ -144,10 +144,10 @@ gfc_check_any_c_kind (gfc_typespec *ts) Fortran kind being used exists in at least some form for C. */ if (c_interop_kinds_table[i].f90_type == ts->type && c_interop_kinds_table[i].value == ts->kind) - return SUCCESS; + return true; } - return FAILURE; + return false; } |