re PR fortran/23446 (Valid internal subprogram array argument declaration is not accepted.)

2005-10-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/23446
	* gfortran.h: Primitive for gfc_is_formal_arg.
	* resolve.c(gfc_is_formal_arg): New function to signal across
	several function calls that formal argument lists are being
	processed.
	(resolve_formal_arglist): Set/reset the flag for gfc_is_formal_arg.
	*expr.c(check_restricted): Add check, via gfc_is_formal_arg, if
	symbol is part of an formal argument declaration.

	PR fortran/21459
	* decl.c (add_init_expr_to_sym): Make a new character
	length for each variable, when the expression is NULL
	and link to cl_list.

	PR fortran/20866
	* match.c (recursive_stmt_fcn): New function that tests if
	a statement function resurses through itself or other other
	statement functions.
	(gfc_match_st_function): Call recursive_stmt_fcn to check
	if this is recursive and to raise error if so.

	PR fortran/20849
	PR fortran/20853
	* resolve.c (resolve_symbol): Errors for assumed size arrays
	with default initializer and for external objects with an
	initializer.

	PR fortran/20837
	* decl.c (match_attr_spec): Prevent PUBLIC from being used
	outside a module.

2005-10-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/23446
	* gfortran.dg/host_dummy_index_1.f90: New test.

	PR fortran/21459
	gfortran.dg/automatic_char_len_2.f90: New test.

	PR fortran/20866
	gfortran.dg/recursive_statement_functions.f90: New test.

	PR fortran/20853
	gfortran.dg/assumed_size_dt_dummy.f90: New test.

	PR fortran/20849
	gfortran.dg/external_initializer.f90: New test.

	PR fortran/20837
	non_module_public.f90: New test.

From-SVN: r105518

1 files changed, 42 insertions, 0 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5de16ba..66ebd86 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -50,6 +50,16 @@ static code_stack *cs_base = NULL;
 
 static int forall_flag;
 
+/* Nonzero if we are processing a formal arglist. The corresponding function
+   resets the flag each time that it is read.  */
+static int formal_arg_flag = 0;
+
+int
+gfc_is_formal_arg (void)
+{
+  return formal_arg_flag;
+}
+
 /* Resolve types of formal argument lists.  These have to be done early so that
    the formal argument lists of module procedures can be copied to the
    containing module before the individual procedures are resolved
@@ -78,6 +88,8 @@ resolve_formal_arglist (gfc_symbol * proc)
       || (sym->as && sym->as->rank > 0))
     proc->attr.always_explicit = 1;
 
+  formal_arg_flag = 1;
+
   for (f = proc->formal; f; f = f->next)
     {
       sym = f->sym;
@@ -224,6 +236,7 @@ resolve_formal_arglist (gfc_symbol * proc)
             }
         }
     }
+  formal_arg_flag = 0;
 }
 
 
@@ -4301,6 +4314,26 @@ resolve_symbol (gfc_symbol * sym)
 	}
     }
 
+  /* An assumed-size array with INTENT(OUT) shall not be of a type for which
+     default initialization is defined (5.1.2.4.4).  */
+  if (sym->ts.type == BT_DERIVED
+	&& sym->attr.dummy
+	&& sym->attr.intent == INTENT_OUT
+	&& sym->as->type == AS_ASSUMED_SIZE)
+    {
+      for (c = sym->ts.derived->components; c; c = c->next)
+	{
+	  if (c->initializer)
+	    {
+	      gfc_error ("The INTENT(OUT) dummy argument '%s' at %L is "
+			 "ASSUMED SIZE and so cannot have a default initializer",
+			 sym->name, &sym->declared_at);
+	      return;
+	    }
+	}
+    }
+
+
   /* Ensure that derived type formal arguments of a public procedure
      are not of a private type.  */
   if (sym->attr.flavor == FL_PROCEDURE
@@ -4427,6 +4460,15 @@ resolve_symbol (gfc_symbol * sym)
       break;
 
     default:
+
+      /* An external symbol falls through to here if it is not referenced.  */
+      if (sym->attr.external && sym->value)
+	{
+	  gfc_error ("External object at %L may not have an initializer",
+		     &sym->declared_at);
+	  return;
+	}
+
       break;
     }