[patch, libgfortran] PR38439 I/O PD edit descriptor inconsistency

[Jerry DeLisle <jvdelisle at verizon dot net>]

Hi all,

The attached patch has been regression tested on x86_64-unknown-gnu-linux.  None 
of our test cases check for the actual error locus point.  Most of this patch is 
 adjusting the compile time locus to get closer to the point of error with the 
format string.

I think it is safe to commit and see if anyone finds any issues.  None of the 
error messages have been changed.

The patch also detects trying to use an exponent specifier with a D specifier

pr38439.f:3.24:

      write (*,'(d24.15e2)') 1.0d0
                        1
Error: Exponent width not allowed with D specifier in format string at (1)

Note that this could also be a missing comma after the '15'.  As an extension, 
gfortran allows missing commas.  This is what led to some confusion over error 
messages.  So, in this corner case we throw an error. See PR for more details.

If you add the comma, we get:

pr38439.f:3.26:

      write (*,'(d24.15,e2)') 1.0d0
                          1
Error: Period required in format specifier at (1)

I think if we try to go any further with this nonsense trying to catch every 
conceivable combination and allow missing commas, it is a waste of effort.

I considered making missing commas an error and only allow with -std=legacy, but 
this would be a change of behaviour.  These kinds of refinements can be real 
time eaters.  So I leave as an exercise for newer folks to learn on or anyone 
inclined to tinker with it.

OK for trunk?  I will include the test case from the PR.

Regards,

Jerry
Index: io.c
===================================================================
--- io.c	(revision 146339)
+++ io.c	(working copy)
@@ -574,7 +574,7 @@ format_item_1:
     case FMT_X:
       /* X requires a prior number if we're being pedantic.  */
       if (gfc_notify_std (GFC_STD_GNU, "Extension: X descriptor "
-			  "requires leading space count at %C")
+			  "requires leading space count at %L", &format_locus)
 	  == FAILURE)
 	return FAILURE;
       goto between_desc;
@@ -597,12 +597,13 @@ format_item_1:
       if (t == FMT_ERROR)
 	goto fail;
 
-      if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %C")
-	  == FAILURE)
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %L",
+	  &format_locus) == FAILURE)
 	return FAILURE;
       if (t != FMT_RPAREN || level > 0)
 	{
-	  gfc_warning ("$ should be the last specifier in format at %C");
+	  gfc_warning ("$ should be the last specifier in format at %L",
+		       &format_locus);
 	  goto optional_comma_1;
 	}
 
@@ -681,8 +682,10 @@ data_desc:
       switch (gfc_notification_std (GFC_STD_GNU))
 	{
 	  case WARNING:
+	    if (mode != MODE_FORMAT)
+	      format_locus.nextc += format_string_pos;
 	    gfc_warning ("Extension: Missing positive width after L "
-			 "descriptor at %C");
+			 "descriptor at %L", &format_locus);
 	    saved_token = t;
 	    break;
 
@@ -725,7 +728,7 @@ data_desc:
 	      goto syntax;
 	    }
 	  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in "
-			      "format at %C") == FAILURE)
+			      "format at %L", &format_locus) == FAILURE)
 	    return FAILURE;
 	  u = format_lex ();
 	  if (u != FMT_PERIOD)
@@ -755,10 +758,14 @@ data_desc:
       if (u != FMT_PERIOD)
 	{
 	  /* Warn if -std=legacy, otherwise error.  */
+	  if (mode != MODE_FORMAT)
+	    format_locus.nextc += format_string_pos;
 	  if (gfc_option.warn_std != 0)
-	    gfc_error_now ("Period required in format specifier at %C");
+	    gfc_error_now ("Period required in format specifier at %L",
+			   &format_locus);
 	  else
-	    gfc_warning ("Period required in format specifier at %C");
+	    gfc_warning ("Period required in format specifier at %L",
+			 &format_locus);
 	  saved_token = u;
 	  break;
 	}
@@ -772,13 +779,18 @@ data_desc:
 	  goto syntax;
 	}
 
-      if (t == FMT_D)
-	break;
-
       /* Look for optional exponent.  */
       u = format_lex ();
       if (u == FMT_ERROR)
 	goto fail;
+
+      /* Optional exponent not allowed with D specifier.  */
+      if (t == FMT_D && u == FMT_E)
+	{
+	  error = _("Exponent width not allowed with D specifier");
+	  goto syntax;
+	}
+
       if (u != FMT_E)
 	{
 	  saved_token = u;
@@ -818,10 +830,15 @@ data_desc:
       if (t != FMT_PERIOD)
 	{
 	  /* Warn if -std=legacy, otherwise error.  */
+	  if (mode != MODE_FORMAT)
+	    format_locus.nextc += format_string_pos;
 	  if (gfc_option.warn_std != 0)
-	    gfc_error_now ("Period required in format specifier at %C");
-	  else
-	    gfc_warning ("Period required in format specifier at %C");
+	    {
+	      error = _("Period required in format specifier at %L");
+	      goto syntax;
+	    }
+	  gfc_warning ("Period required in format specifier at %L",
+		       &format_locus);
 	  saved_token = t;
 	  break;
 	}
@@ -839,8 +856,12 @@ data_desc:
 
     case FMT_H:
       if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
-	gfc_warning ("The H format specifier at %C is"
-		     " a Fortran 95 deleted feature");
+	{
+	  if (mode != MODE_FORMAT)
+	    format_locus.nextc += format_string_pos;
+	  gfc_warning ("The H format specifier at %L is"
+		       " a Fortran 95 deleted feature", &format_locus);
+	}
 
       if (mode == MODE_STRING)
 	{
@@ -924,8 +945,10 @@ between_desc:
       goto syntax;
 
     default:
-      if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %C")
-	  == FAILURE)
+      if (mode != MODE_FORMAT)
+	format_locus.nextc += format_string_pos;
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
+	  &format_locus) == FAILURE)
 	return FAILURE;
       goto format_item_1;
     }
@@ -981,15 +1004,17 @@ extension_optional_comma:
       goto syntax;
 
     default:
-      if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %C")
-	  == FAILURE)
+      if (mode != MODE_FORMAT)
+	format_locus.nextc += format_string_pos;
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
+	  &format_locus) == FAILURE)
 	return FAILURE;
       saved_token = t;
       break;
     }
 
   goto format_item;
-
+  
 syntax:
   if (mode != MODE_FORMAT)
     format_locus.nextc += format_string_pos;