[patch, fortran] PR37746 Diagnostic of edit descriptors, esp. EN

[Jerry DeLisle <jvdelisle at verizon dot net>]

Greetings,

The attached patch greatly improves the diagnostics for D, G, E, EN, ES 
format specifiers.  I added a simple helper function to convert the 
token to a string that can be used in error messages.

I also found that we were completely missing a check for the required 
format width.  This is now added in with the patch.  The overall error 
locus was improved by the patch to 41075.

Regression tested on X86-64 Linux.  Test case attached.

OK for trunk.

Regards,

Jerry

2009-08-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

    PR fortran/37446
    * io.c (enum format_token): Change FMT_EXT to FMT_EN and FMT_ES.
    (format_lex): Likewise.
    (token_to_string): New function.
    (check_format): Use the new tokens and the new function. Add
    check for positive width.

Index: io.c
===================================================================
--- io.c	(revision 151009)
+++ io.c	(working copy)
@@ -110,8 +110,8 @@
   FMT_NONE, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
   FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_LPAREN,
   FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F,
-  FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_ERROR, FMT_DC,
-  FMT_DP, FMT_T, FMT_TR, FMT_TL, FMT_STAR
+  FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END,
+  FMT_ERROR, FMT_DC, FMT_DP, FMT_T, FMT_TR, FMT_TL, FMT_STAR
 }
 format_token;
 
@@ -416,8 +416,10 @@
 
     case 'E':
       c = next_char_not_space (&error);
-      if (c == 'N' || c == 'S')
-	token = FMT_EXT;
+      if (c == 'N' )
+	token = FMT_EN;
+      else if (c == 'S')
+        token = FMT_ES;
       else
 	{
 	  token = FMT_E;
@@ -485,6 +487,26 @@
 }
 
 
+static const char *
+token_to_string (format_token t)
+{
+  switch (t)
+    {
+      case FMT_D:
+	return "D";
+      case FMT_G:
+	return "G";
+      case FMT_E:
+	return "E";
+      case FMT_EN:
+	return "EN";
+      case FMT_ES:
+	return "ES";
+      default:
+        return "";
+    }
+}
+
 /* Check a format statement.  The format string, either from a FORMAT
    statement or a constant in an I/O statement has already been parsed
    by itself, and we are checking it for validity.  The dual origin
@@ -633,7 +655,8 @@
     case FMT_IBOZ:
     case FMT_F:
     case FMT_E:
-    case FMT_EXT:
+    case FMT_EN:
+    case FMT_ES:
     case FMT_G:
     case FMT_L:
     case FMT_A:
@@ -736,7 +759,8 @@
     case FMT_D:
     case FMT_E:
     case FMT_G:
-    case FMT_EXT:
+    case FMT_EN:
+    case FMT_ES:
       u = format_lex ();
       if (t == FMT_G && u == FMT_ZERO)
 	{
@@ -770,20 +794,35 @@
 	  break;
 	}
 
+      if (u != FMT_POSINT)
+	{
+	  format_locus.nextc += format_string_pos;
+	  gfc_error_now ("Positive width required in format "
+			 "specifier %s at %L", token_to_string (t),
+			 &format_locus);
+	  saved_token = u;
+	  goto finished;
+	}
+
       u = format_lex ();
       if (u == FMT_ERROR)
 	goto fail;
       if (u != FMT_PERIOD)
 	{
 	  /* Warn if -std=legacy, otherwise error.  */
-	  if (mode != MODE_FORMAT)
-	    format_locus.nextc += format_string_pos;
+	  format_locus.nextc += format_string_pos;
 	  if (gfc_option.warn_std != 0)
-	    gfc_error_now ("Period required in format specifier at %L",
-			   &format_locus);
+	    {
+	      gfc_error_now ("Period required in format "
+			     "specifier %s at %L", token_to_string (t),
+			     &format_locus);
+	      saved_token = u;
+	      goto finished;
+	    }
 	  else
-	    gfc_warning ("Period required in format specifier at %L",
-			 &format_locus);
+	    gfc_warning ("Period required in format "
+			 "specifier %s at %L", token_to_string (t),
+			  &format_locus);
 	  saved_token = u;
 	  break;
 	}

! { dg-do compile }
! PR37746 Diagnostic of edit descriptors, esp. EN
      character(40) :: fmt_string
      write(*, '(1P,2E12.4)') 1.0
      write(*,'(EN)') 5.0 ! { dg-error "Positive width required" }
      write(*,'("abcdefg",EN6,"hjjklmnop")') 5.0 ! { dg-error "Period required" }
      end