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

[Jerry DeLisle <jvdelisle at verizon dot net>]

Hi All,

The attached patch does several things.

1) Cleans up some comments.

2) Adds runtime error checking for tokens not allowed after a P specifier.

3) Initialize default exponent width where exponent width is optional.

4) Removes some unneeded code.

5) Adjusts the error locus for a few error messages.

The result is as follows.  (There are many variations I will show a few here.)

Compile time:

--- With -std=gnu.

      WRITE (*,'(1PxD24.15,3x,E11.5)') 1.0d0, 1.234
                   1
Error: Comma required after P descriptor in format string at (1)

--- With -std=f95 and comma after P.

pr38439.f:3.20:

      WRITE (*,'(1P,xD24.15,3x,E11.5)') 1.0d0, 1.234
                    1
Error: Extension: X descriptor requires leading space count at (1)

--- No comma after the X. Accepted with -std=gnu.

pr38439.f:4.23:

      WRITE (*,'(1P,1xD24.15,3x,E11.5)') 1.0d0, 1.234
                      1
Error: Extension: Missing comma at (1)

--- No precision specified on E is rejected at compile and run time.

pr38439.f:4.36:

      WRITE (*,'(1P,1x,D24.15,3x,E11)') 1.0d0, 1.234
                                    1
Error: Period required in format specifier E at (1)

On the run time side of things:

At line 5 of file rpr38439.f (unit = 6, file = 'stdout')
Fortran runtime error: Comma required after P descriptor
(1PxD24.15,3x,E11.5)
   ^
The following are accepted.

'(1PD24.15,3x,E11.5)'

'(1PD24.15,3xE11.5)'


Regression tested on x86-64.  OK for trunk.

Regards,

Jerry

2009-10-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/38439
	* io.c (check_format): Fix locus for error messages and fix a comment.

2009-10-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/38439
	* io/format.c (parse_format_list): Add check for tokens not allowed
	after P specifier. Fix comments.  Remove un-needed code. Fix the
	default exponent list. Correct pointer assignment error.

Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c	(revision 152583)
+++ gcc/fortran/io.c	(working copy)
@@ -643,6 +643,8 @@ format_item_1:
 
     case FMT_X:
       /* X requires a prior number if we're being pedantic.  */
+      if (mode != MODE_FORMAT)
+	format_locus.nextc += format_string_pos + 1;
       if (gfc_notify_std (GFC_STD_GNU, "Extension: X descriptor "
 			  "requires leading space count at %L", &format_locus)
 	  == FAILURE)
@@ -722,7 +724,7 @@ data_desc:
       break;
 
     case FMT_P:
-      /* Comma after P is allowed only for F, E, EN, ES, D, or G.
+      /* No comma after P allowed only for F, E, EN, ES, D, or G.
 	 10.1.1 (1).  */
       t = format_lex ();
       if (t == FMT_ERROR)
@@ -1052,7 +1054,7 @@ between_desc:
 
     default:
       if (mode != MODE_FORMAT)
-	format_locus.nextc += format_string_pos;
+	format_locus.nextc += format_string_pos - 1;
       if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
 	  &format_locus) == FAILURE)
 	return FAILURE;
Index: libgfortran/io/format.c
===================================================================
--- libgfortran/io/format.c	(revision 152583)
+++ libgfortran/io/format.c	(working copy)
@@ -706,6 +706,12 @@ parse_format_list (st_parameter_dt *dtp, bool *sav
 	  goto data_desc;
 	}
 
+      if (t != FMT_COMMA && t != FMT_RPAREN && t != FMT_SLASH)
+	{
+	  fmt->error = "Comma required after P descriptor";
+	  goto finished;
+	}
+
       fmt->saved_token = t;
       goto optional_comma;
 
@@ -734,7 +740,7 @@ parse_format_list (st_parameter_dt *dtp, bool *sav
       goto between_desc;
 
     case FMT_STRING:
-      /* TODO: Find out why is is necessary to turn off format caching.  */
+      /* TODO: Find out why it is necessary to turn off format caching.  */
       saveit = false;
       get_fnode (fmt, &head, &tail, FMT_STRING);
       tail->u.string.p = fmt->string;
@@ -851,19 +857,6 @@ parse_format_list (st_parameter_dt *dtp, bool *sav
  data_desc:
   switch (t)
     {
-    case FMT_P:
-      t = format_lex (fmt);
-      if (t == FMT_POSINT)
-	{
-	  fmt->error = "Repeat count cannot follow P descriptor";
-	  goto finished;
-	}
-
-      fmt->saved_token = t;
-      get_fnode (fmt, &head, &tail, FMT_P);
-
-      goto optional_comma;
-
     case FMT_L:
       t = format_lex (fmt);
       if (t != FMT_POSINT)
@@ -971,6 +964,7 @@ parse_format_list (st_parameter_dt *dtp, bool *sav
 	    }
 	  fmt->saved_token = t;
 	  tail->u.real.d = 0;
+	  tail->u.real.e = -1;
 	  break;
 	}
 
@@ -982,11 +976,11 @@ parse_format_list (st_parameter_dt *dtp, bool *sav
 	}
 
       tail->u.real.d = fmt->value;
+      tail->u.real.e = -1;
 
-      if (t == FMT_D || t == FMT_F)
+      if (t2 == FMT_D || t2 == FMT_F)
 	break;
 
-      tail->u.real.e = -1;
 
       /* Look for optional exponent */
       t = format_lex (fmt);