re PR fortran/35840 (ICE for character expression in I/O specifier)

2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/35840
	* expr.c (gfc_reduce_init_expr): New function, containing checking code
	from gfc_match_init_expr, so that checking can be deferred. 
	(gfc_match_init_expr): Use gfc_reduce_init_expr.
	* io.c (check_io_constraints): Use gfc_reduce_init_expr instead of 
	checking that the expression is a constant. 
	* match.h (gfc_reduce_init_expr): Prototype added. 

2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/35840
	* gfortran.dg/write_check4.f90: New test.

From-SVN: r141497

6 files changed, 70 insertions, 22 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1075d98..f7f763f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,15 @@
 2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>
 
+	PR fortran/35840
+	* expr.c (gfc_reduce_init_expr): New function, containing checking code
+	from gfc_match_init_expr, so that checking can be deferred. 
+	(gfc_match_init_expr): Use gfc_reduce_init_expr.
+	* io.c (check_io_constraints): Use gfc_reduce_init_expr instead of 
+	checking that the expression is a constant. 
+	* match.h (gfc_reduce_init_expr): Prototype added. 
+
+2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>
+
 	PR fortran/35820
 	* resolve.c (gfc_count_forall_iterators): New function.
 	(gfc_resolve_forall): Use gfc_count_forall_iterators to evaluate 
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 73f2c40..1a5e6db 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2378,21 +2378,15 @@ check_init_expr (gfc_expr *e)
   return t;
 }
 
+/* Reduces a general expression to an initialization expression (a constant).
+   This used to be part of gfc_match_init_expr.
+   Note that this function doesn't free the given expression on FAILURE.  */
 
-/* Match an initialization expression.  We work by first matching an
-   expression, then reducing it to a constant.  */
-
-match
-gfc_match_init_expr (gfc_expr **result)
+gfc_try
+gfc_reduce_init_expr (gfc_expr *expr)
 {
-  gfc_expr *expr;
-  match m;
   gfc_try t;
 
-  m = gfc_match_expr (&expr);
-  if (m != MATCH_YES)
-    return m;
-
   gfc_init_expr = 1;
   t = gfc_resolve_expr (expr);
   if (t == SUCCESS)
@@ -2400,18 +2394,12 @@ gfc_match_init_expr (gfc_expr **result)
   gfc_init_expr = 0;
 
   if (t == FAILURE)
-    {
-      gfc_free_expr (expr);
-      return MATCH_ERROR;
-    }
+    return FAILURE;
 
   if (expr->expr_type == EXPR_ARRAY
       && (gfc_check_constructor_type (expr) == FAILURE
-	  || gfc_expand_constructor (expr) == FAILURE))
-    {
-      gfc_free_expr (expr);
-      return MATCH_ERROR;
-    }
+      || gfc_expand_constructor (expr) == FAILURE))
+    return FAILURE;
 
   /* Not all inquiry functions are simplified to constant expressions
      so it is necessary to call check_inquiry again.  */ 
@@ -2419,6 +2407,33 @@ gfc_match_init_expr (gfc_expr **result)
       && !gfc_in_match_data ())
     {
       gfc_error ("Initialization expression didn't reduce %C");
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Match an initialization expression.  We work by first matching an
+   expression, then reducing it to a constant.  */
+
+match
+gfc_match_init_expr (gfc_expr **result)
+{
+  gfc_expr *expr;
+  match m;
+  gfc_try t;
+
+  expr = NULL;
+
+  m = gfc_match_expr (&expr);
+  if (m != MATCH_YES)
+    return m;
+
+  t = gfc_reduce_init_expr (expr);
+  if (t != SUCCESS)
+    {
+      gfc_free_expr (expr);
       return MATCH_ERROR;
     }
 
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index fb5ef3e..cb89edd 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2973,7 +2973,7 @@ if (condition) \
     {
       static const char * asynchronous[] = { "YES", "NO", NULL };
 
-      if (dt->asynchronous->expr_type != EXPR_CONSTANT)
+      if (gfc_reduce_init_expr (dt->asynchronous) != SUCCESS)
 	{
 	  gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization "
 		     "expression", &dt->asynchronous->where);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index ff9e8a8..81bf421 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -199,6 +199,7 @@ match gfc_match_literal_constant (gfc_expr **, int);
 /* expr.c -- FIXME: this one should be eliminated by moving the
    matcher to matchexp.c and a call to a new function in expr.c that
    only makes sure the init expr. is valid.  */
+gfc_try gfc_reduce_init_expr (gfc_expr *expr);
 match gfc_match_init_expr (gfc_expr **);
 
 /* array.c.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d0d1242..5d4dd10 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,4 +1,9 @@
-2008-10-16  Mikael Morin  <mikael.morin@tele2.fr>
+2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/35840
+	* gfortran.dg/write_check4.f90: New test.
+
+2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>
 
 	PR fortran/35820
 	* gfortran.dg/nested_forall_1.f: New test.
diff --git a/gcc/testsuite/gfortran.dg/write_check4.f90 b/gcc/testsuite/gfortran.dg/write_check4.f90
new file mode 100644
index 0000000..f418ba8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_check4.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR fortran/35840 
+!
+! The asynchronous specifier for a data transfer statement shall be 
+! an initialization expression
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+  character(2) :: no
+  no = "no"
+  open (unit=10, asynchronous = no)              ! Ok, it isn't a transfer stmt
+  write(*,*, asynchronous="Y"//"E"//trim("S  ")) ! Ok, it is an init expr
+  write(*,*, asynchronous=no)  ! { dg-error "must be an initialization expression" } 
+  read (*,*, asynchronous="Y"//"e"//trim("S  "))
+  read (*,*, asynchronous=no)  ! { dg-error "must be an initialization expression" }
+end