gfortran.h (in_prefix): Removed from this header.

2008-08-22  Daniel Kraft  <d@domob.eu>

	* gfortran.h (in_prefix): Removed from this header.
	* match.h (gfc_matching_prefix): Moved and renamed from `in_prefix'.
	* decl.c (in_prefix): Removed from here.
	(gfc_match_prefix): Use new name of `gfc_matching_prefix'.
	* symbol.c (gfc_check_symbol_typed): Ditto.
	* expr.c (check_typed_ns): New helper variable.
	(expr_check_typed_help): New helper method.
	(gfc_expr_check_typed): Rewrote to use gfc_traverse_expr to do the
	work, fixing a minor problem.
	* match.c (gfc_matching_prefix): New variable.

From-SVN: r139435

1 files changed, 23 insertions, 55 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 941b5c5..5e6214b 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3276,68 +3276,36 @@ gfc_expr_set_symbols_referenced (gfc_expr *expr)
 
    The namespace is needed for IMPLICIT typing.  */
 
-gfc_try
-gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict)
+static gfc_namespace* check_typed_ns;
+
+static bool
+expr_check_typed_help (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED,
+                       int* f ATTRIBUTE_UNUSED)
 {
   gfc_try t;
-  gfc_actual_arglist* act;
-  gfc_constructor* c;
-
-  if (!e)
-    return SUCCESS;
-
-  /* FIXME:  Check indices for EXPR_VARIABLE / EXPR_SUBSTRING, too, to catch
-     things like len(arr(1:n)) as specification expression.  */
-
-  switch (e->expr_type)
-    {
-
-    case EXPR_NULL:
-    case EXPR_CONSTANT:
-    case EXPR_SUBSTRING:
-      break;
-
-    case EXPR_VARIABLE:
-      gcc_assert (e->symtree);
-      t = gfc_check_symbol_typed (e->symtree->n.sym, ns, strict, e->where);
-      if (t == FAILURE)
-	return t;
-      break;
-
-    case EXPR_FUNCTION:
-      for (act = e->value.function.actual; act; act = act->next)
-	{
-	  t = gfc_expr_check_typed (act->expr, ns, true);
-	  if (t == FAILURE)
-	    return t;
-	}
-      break;
 
-    case EXPR_OP:
-      t = gfc_expr_check_typed (e->value.op.op1, ns, true);
-      if (t == FAILURE)
-	return t;
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
 
-      t = gfc_expr_check_typed (e->value.op.op2, ns, true);
-      if (t == FAILURE)
-	return t;
+  gcc_assert (e->symtree);
+  t = gfc_check_symbol_typed (e->symtree->n.sym, check_typed_ns,
+                              true, e->where);
 
-      break;
+  return (t == FAILURE);
+}
 
-    case EXPR_STRUCTURE:
-    case EXPR_ARRAY:
-      for (c = e->value.constructor; c; c = c->next)
-	{
-	  t = gfc_expr_check_typed (c->expr, ns, true);
-	  if (t == FAILURE)
-	    return t;
-	}
-      break;
+gfc_try
+gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict)
+{
+  bool error_found;
 
-    default:
-      gcc_unreachable ();
+  /* If this is a top-level variable, do the check with strict given to us.  */
+  if (!strict && e->expr_type == EXPR_VARIABLE && !e->ref)
+    return gfc_check_symbol_typed (e->symtree->n.sym, ns, strict, e->where);
 
-    }
+  /* Otherwise, walk the expression and do it strictly.  */
+  check_typed_ns = ns;
+  error_found = gfc_traverse_expr (e, NULL, &expr_check_typed_help, 0);
 
-  return SUCCESS;
+  return error_found ? FAILURE : SUCCESS;
 }