public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [patch, fortran] PR52393 I/O: "READ format" statement with parenthesized default-char-expr
@ 2016-05-31 19:20 Jerry DeLisle
  2016-06-01  7:26 ` FX
  0 siblings, 1 reply; 5+ messages in thread
From: Jerry DeLisle @ 2016-05-31 19:20 UTC (permalink / raw)
  To: gfortran; +Cc: gcc patches

[-- Attachment #1: Type: text/plain, Size: 611 bytes --]

The attached patch fixes this by adding code to match a default character
expression if the left paren is first matched on a READ statement.  If the
expression is matched the dt-format is set and processing continues.  Otherwise
execution drops through to match a control list as usual.

Regression tested on x86-64-linux. Test case attached.

OK for trunk?

Regards,

Jerry

2016-05-30  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/52393
	* io.c (match_io): For READ, try to match a default character
	expression. If found, set the dt format expression to this,
	otherwise go back and try control list.

[-- Attachment #2: pr52393.diff --]
[-- Type: text/x-patch, Size: 2185 bytes --]

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index da0e1c5..204cce2 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -3689,7 +3689,7 @@ match_io (io_kind k)
   gfc_symbol *sym;
   int comma_flag;
   locus where;
-  locus spec_end;
+  locus spec_end, control;
   gfc_dt *dt;
   match m;
 
@@ -3751,21 +3751,56 @@ match_io (io_kind k)
     {
       /* 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_YES)
+        {
+	  control = gfc_current_locus;
+	  if (k == M_PRINT)
+	    {
+	      /* 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;
+	      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;
+	      comma_flag = 1;
+	      dt->io_unit = default_unit (k);
+	      goto get_io_list;
+	    }
+	  if (k == M_READ)
+	    {
+	      /* Reset current locus to get the initial '(' in an expression.  */
+	      gfc_current_locus = where;
+	      dt->format_expr = NULL;
+	      m = gfc_match_expr (&dt->format_expr);
+	      if (m == MATCH_YES)
+	        {
+		  if (dt->format_expr
+		      && dt->format_expr->ts.type == BT_CHARACTER)
+		    {
+		      comma_flag = 1;
+		      dt->io_unit = default_unit (k);
+		      goto get_io_list;
+		    }
+		  else
+		    {
+		      gfc_free_expr (dt->format_expr);
+		      dt->format_expr = NULL;
+		      gfc_current_locus = control;
+		    }
+		}
+	      else
+	        {
+		  gfc_clear_error ();
+		  gfc_undo_symbols ();
+		  gfc_free_expr (dt->format_expr);
+		  dt->format_expr = NULL;
+		  gfc_current_locus = control;
+		}
+	    }
 	}
     }
 

[-- Attachment #3: fmt_read_3.f90 --]
[-- Type: text/x-fortran, Size: 300 bytes --]

! { dg-do compile }
! PR52392 "READ format" statement with parenthesed default-char-expr
PROGRAM ReadMeTwo
  IMPLICIT NONE
  CHARACTER(10) :: var
  var = "TestStr"
  PRINT ('(') // 'A)', var 
  PRINT ('(') // 'A)', var 
  READ ('(') // 'A)', var  
  PRINT *, var
  READ *, var
END PROGRAM ReadMeTwo


^ permalink raw reply	[flat|nested] 5+ messages in thread
end of thread, other threads:[~2016-06-05 22:28 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-05-31 19:20 [patch, fortran] PR52393 I/O: "READ format" statement with parenthesized default-char-expr Jerry DeLisle
2016-06-01  7:26 ` FX
2016-06-01 16:28   ` Jerry DeLisle
2016-06-03 19:40     ` H.J. Lu
2016-06-05 22:28       ` Jerry DeLisle

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).