diff options
Diffstat (limited to 'gcc/fortran/io.c')
| -rw-r--r-- | gcc/fortran/io.c | 49 |
1 files changed, 31 insertions, 18 deletions
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 5d3f454acc0..58326b707f5 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -119,6 +119,8 @@ format_token; process. */ static gfc_char_t *format_string; static int format_length, use_last_char; +static char error_element; +static locus format_locus; static format_token saved_token; @@ -165,6 +167,9 @@ next_char (int in_string) if (mode == MODE_COPY) *format_string++ = c; + if (mode != MODE_STRING) + format_locus = gfc_current_locus; + c = gfc_wide_toupper (c); return c; } @@ -186,7 +191,7 @@ next_char_not_space (bool *error) char c; do { - c = next_char (0); + error_element = c = next_char (0); if (c == '\t') { if (gfc_option.allow_std & GFC_STD_GNU) @@ -431,14 +436,14 @@ format_lex (void) { if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DP format " "specifier not allowed at %C") == FAILURE) - return FMT_ERROR; + return FMT_ERROR; token = FMT_DP; } else if (c == 'C') { if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DC format " "specifier not allowed at %C") == FAILURE) - return FMT_ERROR; + return FMT_ERROR; token = FMT_DC; } else @@ -469,12 +474,13 @@ format_lex (void) by itself, and we are checking it for validity. The dual origin means that the warning message is a little less than great. */ -static try +static gfc_try check_format (bool is_input) { const char *posint_required = _("Positive width required"); const char *nonneg_required = _("Nonnegative width required"); - const char *unexpected_element = _("Unexpected element"); + const char *unexpected_element = _("Unexpected element '%c' in format string" + " at %L"); const char *unexpected_end = _("Unexpected end of format string"); const char *zero_width = _("Zero width in format descriptor"); const char *g0_precision = _("Specifying precision with G0 not allowed"); @@ -483,7 +489,7 @@ check_format (bool is_input) format_token t, u; int level; int repeat; - try rv; + gfc_try rv; use_last_char = 0; saved_token = FMT_NONE; @@ -960,10 +966,11 @@ extension_optional_comma: goto format_item; syntax: - gfc_error ("%s in format string at %C", error); + if (error == unexpected_element) + gfc_error (error, error_element, &format_locus); + else + gfc_error ("%s in format string at %L", error, &format_locus); fail: - /* TODO: More elaborate measures are needed to show where a problem - is within a format string that has been calculated. */ rv = FAILURE; finished: @@ -974,7 +981,7 @@ finished: /* Given an expression node that is a constant string, see if it looks like a format string. */ -static try +static gfc_try check_format_string (gfc_expr *e, bool is_input) { if (!e || e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT) @@ -982,6 +989,12 @@ check_format_string (gfc_expr *e, bool is_input) mode = MODE_STRING; format_string = e->value.character.string; + + /* More elaborate measures are needed to show where a problem is within a + format string that has been calculated, but that's probably not worth the + effort. */ + format_locus = e->where; + return check_format (is_input); } @@ -1178,7 +1191,7 @@ match_ltag (const io_tag *tag, gfc_st_label ** label) /* Resolution of the FORMAT tag, to be called from resolve_tag. */ -static try +static gfc_try resolve_tag_format (const gfc_expr *e) { if (e->expr_type == EXPR_CONSTANT @@ -1247,7 +1260,7 @@ resolve_tag_format (const gfc_expr *e) /* Do expression resolution and type-checking on an expression tag. */ -static try +static gfc_try resolve_tag (const io_tag *tag, gfc_expr *e) { if (e == NULL) @@ -1404,7 +1417,7 @@ gfc_free_open (gfc_open *open) /* Resolve everything in a gfc_open structure. */ -try +gfc_try gfc_resolve_open (gfc_open *open) { @@ -2004,7 +2017,7 @@ cleanup: /* Resolve everything in a gfc_close structure. */ -try +gfc_try gfc_resolve_close (gfc_close *close) { RESOLVE_TAG (&tag_unit, close->unit); @@ -2128,7 +2141,7 @@ cleanup: } -try +gfc_try gfc_resolve_filepos (gfc_filepos *fp) { RESOLVE_TAG (&tag_unit, fp->unit); @@ -2454,7 +2467,7 @@ gfc_free_dt (gfc_dt *dt) /* Resolve everything in a gfc_dt structure. */ -try +gfc_try gfc_resolve_dt (gfc_dt *dt) { gfc_expr *e; @@ -3692,7 +3705,7 @@ cleanup: /* Resolve everything in a gfc_inquire structure. */ -try +gfc_try gfc_resolve_inquire (gfc_inquire *inquire) { RESOLVE_TAG (&tag_unit, inquire->unit); @@ -3751,7 +3764,7 @@ gfc_free_wait (gfc_wait *wait) } -try +gfc_try gfc_resolve_wait (gfc_wait *wait) { RESOLVE_TAG (&tag_unit, wait->unit); |