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

gcc/fortran/ChangeLog

@@ -1,3 +1,13 @@
+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

gcc/fortran/expr.c

@@ -2378,6 +2378,41 @@ 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.  */
+
+gfc_try
+gfc_reduce_init_expr (gfc_expr *expr)
+{
+  gfc_try t;
+
+  gfc_init_expr = 1;
+  t = gfc_resolve_expr (expr);
+  if (t == SUCCESS)
+    t = check_init_expr (expr);
+  gfc_init_expr = 0;
+
+  if (t == FAILURE)
+    return FAILURE;
+
+  if (expr->expr_type == EXPR_ARRAY
+      && (gfc_check_constructor_type (expr) == FAILURE
+      || 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.  */ 
+  if (!gfc_is_constant_expr (expr) && check_inquiry (expr, 1) != MATCH_YES
+      && !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.  */
@@ -2389,39 +2424,19 @@ gfc_match_init_expr (gfc_expr **result)
   match m;
   gfc_try t;
 
+  expr = NULL;
+
   m = gfc_match_expr (&expr);
   if (m != MATCH_YES)
     return m;
 
-  gfc_init_expr = 1;
-  t = gfc_resolve_expr (expr);
-  if (t == SUCCESS)
-    t = check_init_expr (expr);
-  gfc_init_expr = 0;
-
-  if (t == FAILURE)
+  t = gfc_reduce_init_expr (expr);
+  if (t != SUCCESS)
     {
       gfc_free_expr (expr);
       return MATCH_ERROR;
     }
 
-  if (expr->expr_type == EXPR_ARRAY
-      && (gfc_check_constructor_type (expr) == FAILURE
-	  || gfc_expand_constructor (expr) == FAILURE))
-    {
-      gfc_free_expr (expr);
-      return MATCH_ERROR;
-    }
-
-  /* Not all inquiry functions are simplified to constant expressions
-     so it is necessary to call check_inquiry again.  */ 
-  if (!gfc_is_constant_expr (expr) && check_inquiry (expr, 1) != MATCH_YES
-      && !gfc_in_match_data ())
-    {
-      gfc_error ("Initialization expression didn't reduce %C");
-      return MATCH_ERROR;
-    }
-
   *result = expr;
 
   return MATCH_YES;

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);

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.  */

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.

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