re PR fortran/32095 (Accepts invalid character(len(a)),dimension(1) :: a)

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

	PR fortran/32095
	PR fortran/34228
	* gfortran.h (in_prefix): New global.
	(gfc_check_symbol_typed), (gfc_check_expr_typed): New methods.
	* array.c (match_array_element_spec): Check that bounds-expressions
	don't have symbols not-yet-typed in them.
	* decl.c (var_element): Check that variable used is already typed.
	(char_len_param_value): Check that expression does not contain
	not-yet-typed symbols.
	(in_prefix): New global.
	(gfc_match_prefix): Record using `in_prefix' if we're at the moment
	parsing a prefix or not.
	* expr.c (gfc_expr_check_typed): New method.
	* parse.c (verify_st_order): New argument to disable error output.
	(check_function_result_typed): New helper method.
	(parse_spec): Check that the function-result declaration, if given in
	a prefix, contains no not-yet-typed symbols when the IMPLICIT rules are
	parsed.
	* symbol.c (gfc_check_symbol_typed): Check that a symbol already has
	a type associated to it, otherwise use the IMPLICIT rules or signal
	an error.

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

	PR fortran/32095
	PR fortran/34228
	* gfortran.dg/used_before_typed_1.f90: New test.
	* gfortran.dg/used_before_typed_2.f90: New test.
	* gfortran.dg/used_before_typed_3.f90: New test.
	* gfortran.dg/array_constructor_26.f03: Add -std=gnu to not enable
	legacy-behaviour for the new check.
	* gfortran.dg/array_constructor_27.f03: Ditto.
	* gfortran.dg/blockdata_4.f90: Ditto.
	* gfortran.dg/bound_2.f90: Reordered declarations to satisfy the check.
	* gfortran.dg/result_in_spec_1.f90: Ditto.
	* gfortran.dg/argument_checking_7.f90: Adapted expected error messages.

From-SVN: r139425

1 files changed, 25 insertions, 3 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 1249780..892c8f3 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -247,6 +247,11 @@ var_element (gfc_data_variable *new_var)
 
   sym = new_var->expr->symtree->n.sym;
 
+  /* Symbol should already have an associated type.  */
+  if (gfc_check_symbol_typed (sym, gfc_current_ns,
+			      false, gfc_current_locus) == FAILURE)
+    return MATCH_ERROR;
+
   if (!sym->attr.function && gfc_current_ns->parent
       && gfc_current_ns->parent == sym->ns)
     {
@@ -598,6 +603,11 @@ char_len_param_value (gfc_expr **expr)
     }
 
   m = gfc_match_expr (expr);
+
+  if (m == MATCH_YES
+      && gfc_expr_check_typed (*expr, gfc_current_ns, false) == FAILURE)
+    return MATCH_ERROR;
+
   if (m == MATCH_YES && (*expr)->expr_type == EXPR_FUNCTION)
     {
       if ((*expr)->value.function.actual
@@ -3743,6 +3753,8 @@ 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)
 {
@@ -3751,6 +3763,9 @@ gfc_match_prefix (gfc_typespec *ts)
   gfc_clear_attr (&current_attr);
   seen_type = 0;
 
+  gcc_assert (!in_prefix);
+  in_prefix = true;
+
 loop:
   if (!seen_type && ts != NULL
       && gfc_match_type_spec (ts, 0) == MATCH_YES
@@ -3764,7 +3779,7 @@ loop:
   if (gfc_match ("elemental% ") == MATCH_YES)
     {
       if (gfc_add_elemental (&current_attr, NULL) == FAILURE)
-	return MATCH_ERROR;
+	goto error;
 
       goto loop;
     }
@@ -3772,7 +3787,7 @@ loop:
   if (gfc_match ("pure% ") == MATCH_YES)
     {
       if (gfc_add_pure (&current_attr, NULL) == FAILURE)
-	return MATCH_ERROR;
+	goto error;
 
       goto loop;
     }
@@ -3780,13 +3795,20 @@ loop:
   if (gfc_match ("recursive% ") == MATCH_YES)
     {
       if (gfc_add_recursive (&current_attr, NULL) == FAILURE)
-	return MATCH_ERROR;
+	goto error;
 
       goto loop;
     }
 
   /* At this point, the next item is not a prefix.  */
+  gcc_assert (in_prefix);
+  in_prefix = false;
   return MATCH_YES;
+
+error:
+  gcc_assert (in_prefix);
+  in_prefix = false;
+  return MATCH_ERROR;
 }