re PR fortran/29835 (Error message of unknown edit descriptor needs improvement)

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-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  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.

From-SVN: r138063

gcc/fortran/ChangeLog

+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.

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)
@@ -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);
 }
 

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/fmt_error_3.f90

+! { 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

gcc/testsuite/gfortran.dg/fmt_error_4.f90

+! { 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)    \\^" }

gcc/testsuite/gfortran.dg/fmt_error_5.f90

+! { 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) \\^" }

libgfortran/ChangeLog

+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

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,6 +949,9 @@ format_error (st_parameter_dt *dtp, const fnode *f, const char *message)
   if (f != NULL)
     fmt->format_string = f->source;
 
+  if (message == unexpected_element)
+    sprintf (buffer, message, fmt->error_element);
+  else
     sprintf (buffer, "%s\n", message);
 
   j = fmt->format_string - dtp->format;