From cd18d5cd1a79220502f9ac670fbf025280f6b576 Mon Sep 17 00:00:00 2001 From: domob Date: Tue, 22 Jul 2008 17:05:55 +0000 Subject: [PATCH] 2008-07-22 Daniel Kraft PR fortran/29835 * io.c (error_element), (format_locus): New static globals. (unexpected_element): Spelled out this message fully. (next_char): Keep track of locus when not MODE_STRING. (next_char_not_space): Remember last parsed element in error_element. (format_lex): Fix two indentation errors. (check_format): Use format_locus and possibly error_element for a slightly better error message on invalid format. (check_format_string): Set format_locus to start of the string expression used as format. 2008-07-22 Daniel Kraft PR fortran/29835 * io/format.c (struct format_data): New member error_element. (unexpected_element): Added '%c' to message. (next_char): Keep track of last parsed character in fmt->error_element. (format_error): If the message is unexpected_element, output the offending character, too. 2008-07-22 Daniel Kraft PR fortran/29835 * gfortran.dg/fmt_error_3.f90: New test. * gfortran.dg/fmt_error_4.f90: New test. * gfortran.dg/fmt_error_5.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@138063 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 13 +++++++++++ gcc/fortran/io.c | 27 +++++++++++++++++------ gcc/testsuite/ChangeLog | 7 ++++++ gcc/testsuite/gfortran.dg/fmt_error_3.f90 | 36 +++++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/fmt_error_4.f90 | 22 +++++++++++++++++++ gcc/testsuite/gfortran.dg/fmt_error_5.f90 | 22 +++++++++++++++++++ libgfortran/ChangeLog | 9 ++++++++ libgfortran/io/format.c | 10 ++++++--- 8 files changed, 136 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/fmt_error_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/fmt_error_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/fmt_error_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b46306174e1..3e50db4dcc8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2008-07-22 Daniel Kraft + + PR fortran/29835 + * io.c (error_element), (format_locus): New static globals. + (unexpected_element): Spelled out this message fully. + (next_char): Keep track of locus when not MODE_STRING. + (next_char_not_space): Remember last parsed element in error_element. + (format_lex): Fix two indentation errors. + (check_format): Use format_locus and possibly error_element for a + slightly better error message on invalid format. + (check_format_string): Set format_locus to start of the string + expression used as format. + 2008-07-21 Ralf Wildenhues * expr.c (gfc_check_pointer_assign): Fix typo in string. diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 5d3f454acc0..188cf95ad06 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 @@ -474,7 +479,8 @@ 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"); @@ -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: @@ -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); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 21202bd3a1f..a35b25fc210 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2008-07-22 Daniel Kraft + + PR fortran/29835 + * gfortran.dg/fmt_error_3.f90: New test. + * gfortran.dg/fmt_error_4.f90: New test. + * gfortran.dg/fmt_error_5.f90: New test. + 2008-07-22 Manuel Lopez-Ibanez PR 28079 diff --git a/gcc/testsuite/gfortran.dg/fmt_error_3.f90 b/gcc/testsuite/gfortran.dg/fmt_error_3.f90 new file mode 100644 index 00000000000..257f876ed80 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_error_3.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } + +! PR fortran/29835 +! Check for improved format error messages with correct locus and more detailed +! "unexpected element" messages. + +SUBROUTINE format_labels + IMPLICIT NONE + +1 FORMAT (A, & + A, & + Q, & ! { dg-error "Unexpected element 'Q'" } + A) + +2 FORMAT (A, & + I, & ! { dg-error "Nonnegative width" } + A) + +END SUBROUTINE format_labels + +SUBROUTINE format_strings + IMPLICIT NONE + CHARACTER(len=32), PARAMETER :: str = "hello" + INTEGER :: x + + PRINT '(A, Q, A)', & ! { dg-error "Unexpected element 'Q'" } + str, str, str ! { dg-bogus "Unexpected element" } + + PRINT '(A, ' // & ! { dg-error "Nonnegative width" } + ' I, ' // & + ' A)', str, str, str ! { dg-bogus "Nonnegative width" } + + READ '(Q)', & ! { dg-error "Unexpected element 'Q'" } + x ! { dg-bogus "Unexpected element" } + +END SUBROUTINE format_strings diff --git a/gcc/testsuite/gfortran.dg/fmt_error_4.f90 b/gcc/testsuite/gfortran.dg/fmt_error_4.f90 new file mode 100644 index 00000000000..2310573bd1f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_error_4.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-shouldfail "runtime error" } + +! PR fortran/29835 +! Check for improved format error messages with correct locus and more detailed +! "unexpected element" messages. + +! Now with runtime supplied format strings +SUBROUTINE format_runtime (fmtstr) + IMPLICIT NONE + CHARACTER(len=*) :: fmtstr + CHARACTER(len=32), PARAMETER :: str = "hello" + + PRINT fmtstr, str, str, str +END SUBROUTINE format_runtime + +PROGRAM main + IMPLICIT NONE + CALL format_runtime ('(A, Q, A)') +END PROGRAM main + +! { dg-output "Unexpected element 'Q'.*(\n|\r\n|\r)\\(A, Q, A\\)(\n|\r\n|\r) \\^" } diff --git a/gcc/testsuite/gfortran.dg/fmt_error_5.f90 b/gcc/testsuite/gfortran.dg/fmt_error_5.f90 new file mode 100644 index 00000000000..18de68e0719 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_error_5.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-shouldfail "runtime error" } + +! PR fortran/29835 +! Check for improved format error messages with correct locus and more detailed +! "unexpected element" messages. + +! Now with runtime supplied format strings +SUBROUTINE format_runtime (fmtstr) + IMPLICIT NONE + CHARACTER(len=*) :: fmtstr + INTEGER :: x + + PRINT fmtstr, x +END SUBROUTINE format_runtime + +PROGRAM main + IMPLICIT NONE + CALL format_runtime ('(Q)') +END PROGRAM main + +! { dg-output "Unexpected element 'Q'.*(\n|\r\n|\r)\\(Q\\)(\n|\r\n|\r) \\^" } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2437c4f379c..cf559109544 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2008-07-22 Daniel Kraft + + PR fortran/29835 + * io/format.c (struct format_data): New member error_element. + (unexpected_element): Added '%c' to message. + (next_char): Keep track of last parsed character in fmt->error_element. + (format_error): If the message is unexpected_element, output the + offending character, too. + 2008-07-22 Thomas Koenig PR libfortran/36890 diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index cf299c161a4..02ce2913bd2 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -50,6 +50,7 @@ typedef struct format_data { char *format_string, *string; const char *error; + char error_element; format_token saved_token; int value, format_string_len, reversion_ok; fnode *avail; @@ -67,7 +68,7 @@ static const fnode colon_node = { FMT_COLON, 0, NULL, NULL, {{ 0, 0, 0 }}, 0, static const char posint_required[] = "Positive width required in format", period_required[] = "Period required in format", nonneg_required[] = "Nonnegative width required in format", - unexpected_element[] = "Unexpected element in format", + unexpected_element[] = "Unexpected element '%c' in format\n", unexpected_end[] = "Unexpected end of format string", bad_string[] = "Unterminated character constant in format", bad_hollerith[] = "Hollerith constant extends past the end of the format", @@ -89,7 +90,7 @@ next_char (format_data *fmt, int literal) return -1; fmt->format_string_len--; - c = toupper (*fmt->format_string++); + fmt->error_element = c = toupper (*fmt->format_string++); } while ((c == ' ' || c == '\t') && !literal); @@ -948,7 +949,10 @@ format_error (st_parameter_dt *dtp, const fnode *f, const char *message) if (f != NULL) fmt->format_string = f->source; - sprintf (buffer, "%s\n", message); + if (message == unexpected_element) + sprintf (buffer, message, fmt->error_element); + else + sprintf (buffer, "%s\n", message); j = fmt->format_string - dtp->format; -- 2.11.0