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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 30329d030d20763fb50e60d95e82a86f3d6c264e..1b588cd9d9ca9549a2bb99cfcc5aa552b5ec0570 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+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

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 892c8f3e99b678d864887a7ac4f25cf1aaeeb1e9..04d25cc7eff78d52ff1342e0326893aa6bbb73ea 100644 (file)
--- 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 941b5c5581a4ea70e74e5db90ffd10ce94f5f04f..5e6214b73860fbd60a6811dd9ff73650e8a4b5e0 100644 (file)
--- 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 a9a363362a21b2ca92d3cacc76f969bcff802fc1..6b5c02a79ee08850e1f3b989051714b01df2f344 100644 (file)
--- 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 42fe7943aea9e4edeb67f3d6bddfc81e5435f4d8..a02d1d17c667aa99a88f19e005eac4a5b49bddf9 100644 (file)
--- 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 9c9d206822cf9755c3a8e27ce26a1f5d3d62f24b..02d088e12d2c8447a0521a0da588a2274471a05c 100644 (file)
--- 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 195982271151523dc204c4366300f773d6e71737..f49f773d20e6b1a81bfff0232c406747f6d214a9 100644 (file)
--- 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 928a34b1d50ee042220b555c1b562d78f9894298..ae16c70a1f355dd6dfee37ca27ee4839731b4eeb 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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

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 (file)
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