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

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

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;
+		}
+	    }
 	}
     }
 

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

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
+