+2008-07-22 Daniel Kraft <d@domob.eu>
+
+ 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 <Ralf.Wildenhues@gmx.de>
* expr.c (gfc_check_pointer_assign): Fix typo in string.
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;
if (mode == MODE_COPY)
*format_string++ = c;
+ if (mode != MODE_STRING)
+ format_locus = gfc_current_locus;
+
c = gfc_wide_toupper (c);
return c;
}
char c;
do
{
- c = next_char (0);
+ error_element = c = next_char (0);
if (c == '\t')
{
if (gfc_option.allow_std & GFC_STD_GNU)
{
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
{
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");
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:
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);
}
+2008-07-22 Daniel Kraft <d@domob.eu>
+
+ 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 <manu@gcc.gnu.org>
PR 28079
--- /dev/null
+! { 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
--- /dev/null
+! { 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) \\^" }
--- /dev/null
+! { 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) \\^" }
+2008-07-22 Daniel Kraft <d@domob.eu>
+
+ 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 <tkoenig@gcc.gnu.org>
PR libfortran/36890
{
char *format_string, *string;
const char *error;
+ char error_element;
format_token saved_token;
int value, format_string_len, reversion_ok;
fnode *avail;
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",
return -1;
fmt->format_string_len--;
- c = toupper (*fmt->format_string++);
+ fmt->error_element = c = toupper (*fmt->format_string++);
}
while ((c == ' ' || c == '\t') && !literal);
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;
projects / gcc.git / commitdiff