re PR fortran/33268 (read ('(f3.3)'), a rejected due to the extra (...))

2008-05-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/33268
	* gfortran.h: Add extra_comma pointer to gfc_dt structure. Add iokind to
	gfc_expr value union. Add io_kind enum to here from io.c.
	* io.c (gfc_free_dt): Free extra_comma.
	(gfc_resolve_dt): If an extra comma was encountered and io_unit is type
	BT_CHARACTER, resolve to format_expr and set default unit.  Error if
	io_kind is M_WRITE. (match_io):  Match the extra comma and set new
	pointer, extra_comma.

From-SVN: r134900

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a0755f88124e07212bafd953b3ed4701b91ed688..9029fc0e622a3df2d903a0338de0946ce1fdceb6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2008-05-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/33268
+       * gfortran.h: Add extra_comma pointer to gfc_dt structure. Add iokind to
+       gfc_expr value union. Add io_kind enum to here from io.c.
+       * io.c (gfc_free_dt): Free extra_comma.
+       (gfc_resolve_dt): If an extra comma was encountered and io_unit is type
+       BT_CHARACTER, resolve to format_expr and set default unit.  Error if
+       io_kind is M_WRITE. (match_io):  Match the extra comma and set new
+       pointer, extra_comma.
+
 2008-05-01  Bud Davis  <bdavis9659@sbcglobal.net>
 
        PR35940/Fortran

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 168f07862b56f0dda72f00b742298264c7cfa23f..f6a7c54123b8f8ef19dc492b4c352e8bbc072373 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -103,6 +103,12 @@ mstring;
 
 /*************************** Enums *****************************/
 
+/* Used when matching and resolving data I/O transfer statements.  */
+
+typedef enum
+{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
+io_kind;
+
 /* The author remains confused to this day about the convention of
    returning '0' for 'SUCCESS'... or was it the other way around?  The
    following enum makes things much more readable.  We also start
@@ -1444,6 +1450,8 @@ typedef struct gfc_expr
   {
     int logical;
 
+    io_kind iokind;
+
     mpz_t integer;
 
     mpfr_t real;
@@ -1684,7 +1692,7 @@ typedef struct
 {
   gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
           *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
-          *sign;
+          *sign, *extra_comma;
 
   gfc_symbol *namelist;
   /* A format_label of `format_asterisk' indicates the "*" format */

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 11907a72a89d55d7323e0f00ede09df5b75d17e3..4eb76309ede169f173cb896385b307f51134934a 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2143,11 +2143,6 @@ gfc_match_flush (void)
 
 /******************** Data Transfer Statements *********************/
 
-typedef enum
-{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
-io_kind;
-
-
 /* Return a default unit number.  */
 
 static gfc_expr *
@@ -2421,6 +2416,7 @@ gfc_free_dt (gfc_dt *dt)
   gfc_free_expr (dt->round);
   gfc_free_expr (dt->blank);
   gfc_free_expr (dt->decimal);
+  gfc_free_expr (dt->extra_comma);
   gfc_free (dt);
 }
 
@@ -2451,9 +2447,40 @@ gfc_resolve_dt (gfc_dt *dt)
       && (e->ts.type != BT_INTEGER
          && (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE)))
     {
-      gfc_error ("UNIT specification at %L must be an INTEGER expression "
-                "or a CHARACTER variable", &e->where);
-      return FAILURE;
+      /* If there is no extra comma signifying the "format" form of the IO
+        statement, then this must be an error.  */
+      if (!dt->extra_comma)
+       {
+         gfc_error ("UNIT specification at %L must be an INTEGER expression "
+                    "or a CHARACTER variable", &e->where);
+         return FAILURE;
+       }
+      else
+       {
+         /* At this point, we have an extra comma.  If io_unit has arrived as
+            type chracter, we assume its really the "format" form of the I/O
+            statement.  We set the io_unit to the default unit and format to
+            the chracter expression.  See F95 Standard section 9.4.  */
+         io_kind k;
+         k = dt->extra_comma->value.iokind;
+         if (e->ts.type == BT_CHARACTER && (k == M_READ || k == M_PRINT))
+           {
+             dt->format_expr = dt->io_unit;
+             dt->io_unit = default_unit (k);
+
+             /* Free this pointer now so that a warning/error is not triggered
+                below for the "Extension".  */
+             gfc_free_expr (dt->extra_comma);
+             dt->extra_comma = NULL;
+           }
+
+         if (k == M_WRITE)
+           {
+             gfc_error ("Invalid form of WRITE statement at %L, UNIT required",
+                        &dt->extra_comma->where);
+             return FAILURE;
+           }
+       }
     }
 
   if (e->ts.type == BT_CHARACTER)
@@ -2471,6 +2498,11 @@ gfc_resolve_dt (gfc_dt *dt)
       return FAILURE;
     }
 
+  if (dt->extra_comma
+      && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o "
+                        "item list at %L", &dt->extra_comma->where) == FAILURE)
+    return FAILURE;
+
   if (dt->err)
     {
       if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE)
@@ -3306,12 +3338,23 @@ get_io_list:
   /* Used in check_io_constraints, where no locus is available.  */
   spec_end = gfc_current_locus;
 
-  /* Optional leading comma (non-standard).  */
-  if (!comma_flag
-      && gfc_match_char (',') == MATCH_YES
-      && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o "
-                        "item list at %C") == FAILURE)
-    return MATCH_ERROR;
+  /* Optional leading comma (non-standard).  We use a gfc_expr structure here
+     to save the locus.  This is used later when resolving transfer statements
+     that might have a format expression without unit number.  */
+  if (!comma_flag && gfc_match_char (',') == MATCH_YES)
+    {
+      dt->extra_comma = gfc_get_expr ();
+
+      /* Set the types to something compatible with iokind. This is needed to
+        get through gfc_free_expr later since iokind really has no Basic Type,
+        BT, of its own.  */
+      dt->extra_comma->expr_type = EXPR_CONSTANT;
+      dt->extra_comma->ts.type = BT_LOGICAL;
+
+      /* Save the iokind and locus for later use in resolution.  */
+      dt->extra_comma->value.iokind = k;
+      dt->extra_comma->where = gfc_current_locus;
+    }
 
   io_code = NULL;
   if (gfc_match_eos () != MATCH_YES)