2007-06-29 Tobias Burnus <burnus@net-b.de>

	PR fortran/32483
	* io.c (format_lex): Fix FMT_ZERO.
	(check_format,check_format_string,gfc_match_format,
	check_io_constraints) Additional checking for READ.

2007-06-29  Tobias Burnus  <burnus@net-b.de>

	PR fortran/32483
	* gfortran.dg/fmt_read_2.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126107 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d8be930..dc08f63 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-06-29  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/32483
+       * io.c (format_lex): Fix FMT_ZERO.
+       (check_format,check_format_string,gfc_match_format,
+       check_io_constraints) Additional checking for READ.
+
 2007-06-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
 
        PR other/31400

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index aa299a3..f9b5eac 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -257,10 +257,12 @@ format_lex (void)
       do
        {
          c = next_char_not_space ();
-         if (c != '0')
-           zflag = 0;
          if (ISDIGIT (c))
-           value = 10 * value + c - '0';
+           {
+             value = 10 * value + c - '0';
+             if (c != '0')
+               zflag = 0;
+           }
        }
       while (ISDIGIT (c));
 
@@ -429,7 +431,7 @@ format_lex (void)
    means that the warning message is a little less than great.  */
 
 static try
-check_format (void)
+check_format (bool is_input)
 {
   const char *posint_required    = _("Positive width required");
   const char *nonneg_required    = _("Nonnegative width required");
@@ -670,6 +672,11 @@ data_desc:
          error = nonneg_required;
          goto syntax;
        }
+      else if (is_input && t == FMT_ZERO)
+       {
+         error = posint_required;
+         goto syntax;
+       }
 
       t = format_lex ();
       if (t != FMT_PERIOD)
@@ -719,6 +726,11 @@ data_desc:
          error = nonneg_required;
          goto syntax;
        }
+      else if (is_input && t == FMT_ZERO)
+       {
+         error = posint_required;
+         goto syntax;
+       }
 
       t = format_lex ();
       if (t != FMT_PERIOD)
@@ -854,11 +866,11 @@ finished:
    like a format string.  */
 
 static void
-check_format_string (gfc_expr *e)
+check_format_string (gfc_expr *e, bool is_input)
 {
   mode = MODE_STRING;
   format_string = e->value.character.string;
-  check_format ();
+  check_format (is_input);
 }
 
 
@@ -893,7 +905,7 @@ gfc_match_format (void)
 
   start = gfc_current_locus;
 
-  if (check_format () == FAILURE)
+  if (check_format (false) == FAILURE)
     return MATCH_ERROR;
 
   if (gfc_match_eos () != MATCH_YES)
@@ -920,7 +932,7 @@ gfc_match_format (void)
   gfc_statement_label->format = e;
 
   mode = MODE_COPY;
-  check_format ();             /* Guaranteed to succeed */
+  check_format (false);                /* Guaranteed to succeed */
   gfc_match_eos ();            /* Guaranteed to succeed */
 
   return MATCH_YES;
@@ -2740,7 +2752,7 @@ if (condition) \
 
   expr = dt->format_expr;
   if (expr != NULL && expr->expr_type == EXPR_CONSTANT)
-    check_format_string (expr);
+    check_format_string (expr, k == M_READ);
 
   return m;
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 00e2dc8..7552ef4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-06-29  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/32483
+       * gfortran.dg/fmt_read_2.f90: New.
+
 2007-06-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        * gfortran.dg/open_errors.f90: Check for existance of temptestfile.