]> gcc.gnu.org Git - gcc.git/commitdiff
re PR fortran/29403 ([4.1 only] print ('(a)') not working, print '(a) works)
authorSteven G. Kargl <kargl@gcc.gnu.org>
Mon, 16 Oct 2006 00:51:46 +0000 (00:51 +0000)
committerSteven G. Kargl <kargl@gcc.gnu.org>
Mon, 16 Oct 2006 00:51:46 +0000 (00:51 +0000)
2006-10-15  Steven G. Kargl  <kargl@gcc.gnu.org>

    PR fortran/29403
    * io.c (match_io):  Check for a default-char-expr for PRINT format.

From-SVN: r117764

gcc/fortran/ChangeLog
gcc/fortran/io.c

index 3e70f31ae861f9de3d3da10d18ff725ef6208a13..aa06cf314d3b0455dc9010d14078162061f48b1b 100644 (file)
@@ -1,3 +1,8 @@
+2006-10-15  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/29403
+       * io.c (match_io):  Check for a default-char-expr for PRINT format.
+
 2006-10-15  Bernhard Fischer  <aldot@gcc.gnu.org>
 
        PR fortran/24767
index 20bf26215d54e1968686ff188ff112c19e26602a..b0dfa8f03119f3b6b3a29fa70834310ebd902738 100644 (file)
@@ -2744,7 +2744,8 @@ match_io (io_kind k)
   where = gfc_current_locus;
   comma_flag = 0;
   current_dt = dt = gfc_getmem (sizeof (gfc_dt));
-  if (gfc_match_char ('(') == MATCH_NO)
+  m = gfc_match_char ('(');
+  if (m == MATCH_NO)
     {
       where = gfc_current_locus;
       if (k == M_WRITE)
@@ -2796,9 +2797,25 @@ match_io (io_kind k)
     }
   else
     {
-      /* Error for constructs like print (1,*).   */
-      if (k == M_PRINT)
-       goto  syntax;
+      /* Before issuing an error for a malformed 'print (1,*)' type of
+        error, check for a default-char-expr of the form ('(I0)').  */
+
+      if (k == M_PRINT && m == MATCH_YES)
+       {
+         /* Reset current locus to get the initial '(' in an expression.  */
+         gfc_current_locus = where;
+         dt->format_expr = NULL;
+         m = match_dt_format (dt);
+
+         if (m == MATCH_ERROR)
+           goto cleanup;
+         if (m == MATCH_NO || dt->format_expr == NULL)
+           goto syntax;
+
+         comma_flag = 1;
+         dt->io_unit = default_unit (k);
+         goto get_io_list;
+       }
     }
 
   /* Match a control list */
This page took 0.073939 seconds and 5 git commands to generate.