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

9 files changed, 76 insertions, 66 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 30329d0..1b588cd 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,18 @@
 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.
+
+2008-08-22  Daniel Kraft  <d@domob.eu>
+
 	PR fortran/32095
 	PR fortran/34228
 	* gfortran.h (in_prefix): New global.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 892c8f3..04d25cc 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3753,8 +3753,6 @@ cleanup:
    can be matched.  Note that if nothing matches, MATCH_YES is
    returned (the null string was matched).  */
 
-bool in_prefix = false;
-
 match
 gfc_match_prefix (gfc_typespec *ts)
 {
@@ -3763,8 +3761,8 @@ gfc_match_prefix (gfc_typespec *ts)
   gfc_clear_attr (&current_attr);
   seen_type = 0;
 
-  gcc_assert (!in_prefix);
-  in_prefix = true;
+  gcc_assert (!gfc_matching_prefix);
+  gfc_matching_prefix = true;
 
 loop:
   if (!seen_type && ts != NULL
@@ -3801,13 +3799,13 @@ loop:
     }
 
   /* At this point, the next item is not a prefix.  */
-  gcc_assert (in_prefix);
-  in_prefix = false;
+  gcc_assert (gfc_matching_prefix);
+  gfc_matching_prefix = false;
   return MATCH_YES;
 
 error:
-  gcc_assert (in_prefix);
-  in_prefix = false;
+  gcc_assert (gfc_matching_prefix);
+  gfc_matching_prefix = false;
   return MATCH_ERROR;
 }
 
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;
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a9a3633..6b5c02a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2245,8 +2245,6 @@ void copy_formal_args (gfc_symbol *dest, gfc_symbol *src);
 
 void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too  */
 
-/* FIXME:  Do this with parser-state instead of global variable.  */
-extern bool in_prefix;
 gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
 
 /* intrinsic.c */
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 42fe794..a02d1d1 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "parse.h"
 
 int gfc_matching_procptr_assignment = 0;
+bool gfc_matching_prefix = false;
 
 /* For debugging and diagnostic purposes.  Return the textual representation
    of the intrinsic operator OP.  */
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 9c9d206..02d088e 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -34,6 +34,7 @@ extern gfc_symbol *gfc_new_block;
 extern gfc_st_label *gfc_statement_label;
 
 extern int gfc_matching_procptr_assignment;
+extern bool gfc_matching_prefix;
 
 /****************** All gfc_match* routines *****************/
 
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 1959822..f49f773 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "flags.h"
 #include "gfortran.h"
 #include "parse.h"
+#include "match.h"
 
 
 /* Strings for all symbol attributes.  We use these for dumping the
@@ -4240,7 +4241,7 @@ gfc_check_symbol_typed (gfc_symbol* sym, gfc_namespace* ns,
 {
   gcc_assert (sym);
 
-  if (in_prefix)
+  if (gfc_matching_prefix)
     return SUCCESS;
 
   /* Check for the type and try to give it an implicit one.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 928a34b..ae16c70 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
 2008-08-22  Daniel Kraft  <d@domob.eu>
 
+	* gfortran.dg/used_before_typed_4.f90: New test.
+
+2008-08-22  Daniel Kraft  <d@domob.eu>
+
 	PR fortran/32095
 	PR fortran/34228
 	* gfortran.dg/used_before_typed_1.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/used_before_typed_4.f90 b/gcc/testsuite/gfortran.dg/used_before_typed_4.f90
new file mode 100644
index 0000000..9d7ccc1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_before_typed_4.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Test for a special case of the used-before-typed errors, when the symbols
+! not-yet-typed are indices.
+
+SUBROUTINE test (n, arr1, m, arr2) ! { dg-error "has no IMPLICIT type" }
+  IMPLICIT NONE
+
+  INTEGER :: myarr(42)
+
+  INTEGER :: arr1(SIZE (myarr(1:n))) ! { dg-error "'n' is used before" }
+  INTEGER :: n
+
+  INTEGER :: arr2(LEN ("hello"(1:m))) ! { dg-error "'m' is used before" }
+  INTEGER :: m
+
+  WRITE (*,*) SIZE (arr1)
+  WRITE (*,*) SIZE (arr2)
+END SUBROUTINE test
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: arr1(42), arr2(42)
+  CALL test (3, arr1, 2, arr2)
+END PROGRAM main