aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/io.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/io.c')
-rw-r--r--gcc/fortran/io.c317
1 files changed, 153 insertions, 164 deletions
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))
generated by cgit v1.1 at 2025-05-22 11:42:25 +0000