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 1cc998e78b586e18f25a3fd51c9289d3557ea676..2a9c9ceab934ab845cd0d6781c8895c23530b699 100644 (file)
--- 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 da0e1c5ec49416f61a2018520e32c9e5ea50bd06..204cce2e5656cecfc3cb88f9de919198669d11a8 100644 (file)
--- 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 5bc66767f446990542172ca5e2ccb85d0f912751..7ee77b62f3f40c0cebdb4c8947aa257823dc768e 100644 (file)
--- 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 (file)
index 0000000..7205369
--- /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
+