From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Wed, 1 Jun 2016 17:06:50 +0000 (+0000)
Subject: re PR fortran/52393 (I/O: "READ format" statement with parenthesed default-char-expr)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4731c9f025a6c14d77e3127b8c64a46bd933c687;p=gcc.git

re PR fortran/52393 (I/O: "READ format" statement with parenthesed default-char-expr)

2016-06-01  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.

	PR fortran/52393
	* gfortran.dg/fmt_read_3.f90: New test.

From-SVN: r237003
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1cc998e78b5..2a9c9ceab93 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2016-06-01  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.
+
 2016-06-01  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/71156
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index da0e1c5ec49..204cce2e565 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;
+		}
+	    }
 	}
     }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5bc66767f44..7ee77b62f3f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-06-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/52393
+	* gfortran.dg/fmt_read_3.f90: New test.
+
 2016-06-01  Thomas Preud'homme  <thomas.preudhomme@arm.com>
 
 	* lib/target-supports.exp (check_effective_target_arm_acq_rel): New
diff --git a/gcc/testsuite/gfortran.dg/fmt_read_3.f90 b/gcc/testsuite/gfortran.dg/fmt_read_3.f90
new file mode 100644
index 00000000000..72053697c40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_read_3.f90
@@ -0,0 +1,13 @@
+! { 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
+