2008-10-09 Daniel Kraft <d@domob.eu>

	PR fortran/35723
	* gfortran.h (gfc_suppress_error): Removed from header.
	(gfc_push_suppress_errors), (gfc_pop_suppress_errors): New methods.
	* array.c (gfc_array_size): Use new gfc_push/pop_suppress_errors
	instead of directly changing gfc_suppress_error.
	* intrinsic.c (gfc_intrinsic_func_interface): Ditto.
	(gfc_intrinsic_sub_interface): Ditto.
	* error.c (suppress_errors): Made static from `gfc_suppress_error'.
	(gfc_push_suppress_errors), (gfc_pop_suppress_errors): New methods.
	(gfc_notify_std), (gfc_error): Use new static name of global.
	* expr.c (check_arglist), (check_references): New methods.
	(check_restricted): Check arglists and references of EXPR_FUNCTIONs
	and EXPR_VARAIBALEs, respectively.  Allow PARAMETER symbols.

2008-10-09  Daniel Kraft  <d@domob.eu>

	PR fortran/35723
	* gfortran.dg/restricted_expression_1.f90: New test.
	* gfortran.dg/restricted_expression_2.f90: New test.
	* gfortran.dg/restricted_expression_3.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@141001 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 80 insertions, 3 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 7f6bf1b07e4..5a167b7067f 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2503,6 +2503,64 @@ restricted_intrinsic (gfc_expr *e)
 }
 
 
+/* Check the expressions of an actual arglist.  Used by check_restricted.  */
+
+static gfc_try
+check_arglist (gfc_actual_arglist* arg, gfc_try (*checker) (gfc_expr*))
+{
+  for (; arg; arg = arg->next)
+    if (checker (arg->expr) == FAILURE)
+      return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Check the subscription expressions of a reference chain with a checking
+   function; used by check_restricted.  */
+
+static gfc_try
+check_references (gfc_ref* ref, gfc_try (*checker) (gfc_expr*))
+{
+  int dim;
+
+  if (!ref)
+    return SUCCESS;
+
+  switch (ref->type)
+    {
+    case REF_ARRAY:
+      for (dim = 0; dim != ref->u.ar.dimen; ++dim)
+	{
+	  if (checker (ref->u.ar.start[dim]) == FAILURE)
+	    return FAILURE;
+	  if (checker (ref->u.ar.end[dim]) == FAILURE)
+	    return FAILURE;
+	  if (checker (ref->u.ar.stride[dim]) == FAILURE)
+	    return FAILURE;
+	}
+      break;
+
+    case REF_COMPONENT:
+      /* Nothing needed, just proceed to next reference.  */
+      break;
+
+    case REF_SUBSTRING:
+      if (checker (ref->u.ss.start) == FAILURE)
+	return FAILURE;
+      if (checker (ref->u.ss.end) == FAILURE)
+	return FAILURE;
+      break;
+
+    default:
+      gcc_unreachable ();
+      break;
+    }
+
+  return check_references (ref->next, checker);
+}
+
+
 /* Verify that an expression is a restricted expression.  Like its
    cousin check_init_expr(), an error message is generated if we
    return FAILURE.  */
@@ -2510,7 +2568,7 @@ restricted_intrinsic (gfc_expr *e)
 static gfc_try
 check_restricted (gfc_expr *e)
 {
-  gfc_symbol *sym;
+  gfc_symbol* sym;
   gfc_try t;
 
   if (e == NULL)
@@ -2526,8 +2584,22 @@ check_restricted (gfc_expr *e)
       break;
 
     case EXPR_FUNCTION:
-      t = e->value.function.esym ? external_spec_function (e)
-				 : restricted_intrinsic (e);
+      if (e->value.function.esym)
+	{
+	  t = check_arglist (e->value.function.actual, &check_restricted);
+	  if (t == SUCCESS)
+	    t = external_spec_function (e);
+	}
+      else
+	{
+	  if (e->value.function.isym && e->value.function.isym->inquiry)
+	    t = SUCCESS;
+	  else
+	    t = check_arglist (e->value.function.actual, &check_restricted);
+
+	  if (t == SUCCESS)
+	    t = restricted_intrinsic (e);
+	}
       break;
 
     case EXPR_VARIABLE:
@@ -2561,6 +2633,10 @@ check_restricted (gfc_expr *e)
 	  break;
 	}
 
+      /* Check reference chain if any.  */
+      if (check_references (e->ref, &check_restricted) == FAILURE)
+	break;
+
       /* gfc_is_formal_arg broadcasts that a formal argument list is being
 	 processed in resolve.c(resolve_formal_arglist).  This is done so
 	 that host associated dummy array indices are accepted (PR23446).
@@ -2571,6 +2647,7 @@ check_restricted (gfc_expr *e)
 	    || sym->attr.use_assoc
 	    || sym->attr.dummy
 	    || sym->attr.implied_index
+	    || sym->attr.flavor == FL_PARAMETER
 	    || (sym->ns && sym->ns == gfc_current_ns->parent)
 	    || (sym->ns && gfc_current_ns->parent
 		  && sym->ns == gfc_current_ns->parent->parent)