re PR fortran/35680 (ICE on invalid transfer in variable declaration)

2008-10-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35680
	* gfortran.h : Add 'error' bit field to gfc_expr structure.
	* expr.c (check_inquiry): When checking a restricted expression
	check that arguments are either variables or restricted.
	(check_restricted): Do not emit error if the expression has
	'error' set.  Clean up detection of host-associated variable.

2008-10-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35680
	* gfortran.dg/transfer_array_intrinsic_5.f90: New test.

From-SVN: r140892

gcc/fortran/ChangeLog

+2008-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35680
+	* gfortran.h : Add 'error' bit field to gfc_expr structure.
+	* expr.c (check_inquiry): When checking a restricted expression
+	check that arguments are either variables or restricted.
+	(check_restricted): Do not emit error if the expression has
+	'error' set.  Clean up detection of host-associated variable.
+
 2008-10-05  Daniel Kraft  <d@domob.eu>
 
 	PR fortran/37638

gcc/fortran/expr.c

@@ -2017,6 +2017,8 @@ check_init_expr_arguments (gfc_expr *e)
   return MATCH_YES;
 }
 
+static gfc_try check_restricted (gfc_expr *);
+
 /* F95, 7.1.6.1, Initialization expressions, (7)
    F2003, 7.1.7 Initialization expression, (8)  */
 
@@ -2096,6 +2098,11 @@ check_inquiry (gfc_expr *e, int not_restricted)
 	  }
 	else if (not_restricted && check_init_expr (ap->expr) == FAILURE)
 	  return MATCH_ERROR;
+
+	if (not_restricted == 0
+	      && ap->expr->expr_type != EXPR_VARIABLE
+	      && check_restricted (ap->expr) == FAILURE)
+	  return MATCH_ERROR;
     }
 
   return MATCH_YES;
@@ -2421,8 +2428,6 @@ gfc_match_init_expr (gfc_expr **result)
 }
 
 
-static gfc_try check_restricted (gfc_expr *);
-
 /* Given an actual argument list, test to see that each argument is a
    restricted expression and optionally if the expression type is
    integer or character.  */
@@ -2561,14 +2566,17 @@ check_restricted (gfc_expr *e)
 	 that host associated dummy array indices are accepted (PR23446).
 	 This mechanism also does the same for the specification expressions
 	 of array-valued functions.  */
-      if (sym->attr.in_common
-	  || sym->attr.use_assoc
-	  || sym->attr.dummy
-	  || sym->attr.implied_index
-	  || sym->ns != gfc_current_ns
-	  || (sym->ns->proc_name != NULL
-	      && sym->ns->proc_name->attr.flavor == FL_MODULE)
-	  || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
+      if (e->error
+	    || sym->attr.in_common
+	    || sym->attr.use_assoc
+	    || sym->attr.dummy
+	    || sym->attr.implied_index
+	    || (sym->ns && sym->ns == gfc_current_ns->parent)
+	    || (sym->ns && gfc_current_ns->parent
+		  && sym->ns == gfc_current_ns->parent->parent)
+	    || (sym->ns->proc_name != NULL
+		  && sym->ns->proc_name->attr.flavor == FL_MODULE)
+	    || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
 	{
 	  t = SUCCESS;
 	  break;
@@ -2576,7 +2584,8 @@ check_restricted (gfc_expr *e)
 
       gfc_error ("Variable '%s' cannot appear in the expression at %L",
 		 sym->name, &e->where);
-
+      /* Prevent a repetition of the error.  */
+      e->error = 1;
       break;
 
     case EXPR_NULL:

gcc/fortran/gfortran.h

@@ -637,10 +637,10 @@ typedef struct
   unsigned function:1, subroutine:1, procedure:1;
   unsigned generic:1, generic_copy:1;
   unsigned implicit_type:1;	/* Type defined via implicit rules.  */
-  unsigned untyped:1;           /* No implicit type could be found.  */
+  unsigned untyped:1;		/* No implicit type could be found.  */
 
-  unsigned is_bind_c:1;		/* say if is bound to C */
-  unsigned extension:1;		/* extends a derived type */
+  unsigned is_bind_c:1;		/* say if is bound to C.  */
+  unsigned extension:1;		/* extends a derived type.  */
 
   /* These flags are both in the typespec and attribute.  The attribute
      list is what gets read from/written to a module file.  The typespec
@@ -1547,6 +1547,10 @@ typedef struct gfc_expr
      and if we have decided not to allocate temporary data for that array.  */
   unsigned int inline_noncopying_intrinsic : 1, is_boz : 1;
 
+  /* Sometimes, when an error has been emitted, it is necessary to prevent
+      it from recurring.  */
+  unsigned int error : 1;
+
   /* Used to quickly find a given constructor by its offset.  */
   splay_tree con_by_offset;
 

gcc/testsuite/ChangeLog

+2008-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35680
+	* gfortran.dg/transfer_array_intrinsic_5.f90: New test.
+
 2008-10-05  Daniel Kraft  <d@domob.eu>
 
 	PR fortran/37638

gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90

+! { dg-do compile }
+! PR35680 - used to ICE because the argument of SIZE, being in a restricted
+! expression, was not checked if it too is restricted or is a variable. Since
+! it is neither, an error should be produced.
+!
+! Contributed by  Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+program main
+  print *, foo (), bar (), foobar ()
+contains
+  function foo ()
+    integer foo(size (transfer (x, [1])))     ! { dg-error "cannot appear" }
+    real x
+ end function
+  function bar()
+    real x
+    integer bar(size (transfer (x, [1])))     ! { dg-error "cannot appear" }
+ end function
+  function foobar()                           ! { dg-error "no IMPLICIT" }
+    implicit none
+    integer foobar(size (transfer (x, [1])))  ! { dg-error "used before" }
+    real x
+ end function
+end program