[patch, fortran] Fix PR42360 + some cleanup

[Daniel Franke <franke dot daniel at gmail dot com>]

Hi all.

This patch fixes a nuisance with warnings with derived type dummy arguments 
with INTENT(OUT) that are not set or default initialized.

Question is, if the updated warning in trans-decl.c (generate_local_decl) is 
now sufficient. It will only trigger if none of the components of the 
(possible nested) type in question has a default initializer. If there is an 
initializer three levels down, the warning is omitted. However, this 
corresponds to the behaviour if at least one component of the dummy argument 
is set in code.


gcc/fortran/:
2010-05-08  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/42360
	* gfortran.h (gfc_has_default_initializer): New.
	* expr.c (gfc_has_default_initializer): New.
	* resolve.c (has_default_initializer): Removed, use
	gfc_has_default_initializer() instead. Updated all callers.
	* trans-array.c (has_default_initializer): Removed, use
	gfc_has_default_initializer() instead. Updated all callers.
	* trans-decl.c (generate_local_decl): Do not check the
	first component only to check for initializers, but use
	gfc_has_default_initializer() instead.

gcc/testsuite/:
2010-05-08  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/42360
	* gfortran.dg/warn_intent_out_not_set.f90: New.


Regression tested on i686-pc-linux-gnu.
Ok for trunk?

	Daniel

! { dg-do "compile" }
! { dg-options "-c -Wall" }
!
! PR fortran/42360
!
MODULE m
  TYPE :: t1
    INTEGER :: a = 42, b
  END TYPE

  TYPE :: t2
    INTEGER :: a, b
  END TYPE

CONTAINS
  SUBROUTINE sub1(x)             ! no warning, default initializer
    type(t1), intent(out) :: x
  END SUBROUTINE

  SUBROUTINE sub2(x)             ! no warning, initialized
    type(t2), intent(out) :: x
    x%a = 42
  END SUBROUTINE

  SUBROUTINE sub3(x)             ! { dg-warning "not set" }
    type(t2), intent(out) :: x
  END SUBROUTINE
END MODULE

! { dg-final { cleanup-modules "m" } }

Index: gfortran.h
===================================================================
--- gfortran.h	(revision 159179)
+++ gfortran.h	(working copy)
@@ -2629,6 +2629,7 @@ gfc_try gfc_check_assign (gfc_expr *, gf
 gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
 
+bool gfc_has_default_initializer (gfc_symbol *);
 gfc_expr *gfc_default_initializer (gfc_typespec *);
 gfc_expr *gfc_get_variable_expr (gfc_symtree *);
 
Index: expr.c
===================================================================
--- expr.c	(revision 159179)
+++ expr.c	(working copy)
@@ -3591,6 +3591,31 @@ gfc_check_assign_symbol (gfc_symbol *sym
 }
 
 
+/* Check for default initializer; sym->value is not enough
+   as it is also set for EXPR_NULL of allocatables.  */
+
+bool
+gfc_has_default_initializer (gfc_symbol *der)
+{
+  gfc_component *c;
+
+  gcc_assert (der->attr.flavor == FL_DERIVED);
+  for (c = der->components; c; c = c->next)
+    if (c->ts.type == BT_DERIVED)
+      {
+        if (!c->attr.pointer
+	     && gfc_has_default_initializer (c->ts.u.derived))
+	  return true;
+      }
+    else
+      {
+        if (c->initializer)
+	  return true;
+      }
+
+  return false;
+}
+
 /* Get an expression for a default initializer.  */
 
 gfc_expr *
@@ -3599,7 +3624,8 @@ gfc_default_initializer (gfc_typespec *t
   gfc_expr *init;
   gfc_component *comp;
 
-  /* See if we have a default initializer.  */
+  /* See if we have a default initializer in this, but not in nested
+     types (otherwise we could use gfc_has_default_initializer()).  */
   for (comp = ts->u.derived->components; comp; comp = comp->next)
     if (comp->initializer || comp->attr.allocatable)
       break;
Index: resolve.c
===================================================================
--- resolve.c	(revision 159179)
+++ resolve.c	(working copy)
@@ -703,21 +703,6 @@ resolve_entries (gfc_namespace *ns)
 }
 
 
-static bool
-has_default_initializer (gfc_symbol *der)
-{
-  gfc_component *c;
-
-  gcc_assert (der->attr.flavor == FL_DERIVED);
-  for (c = der->components; c; c = c->next)
-    if ((c->ts.type != BT_DERIVED && c->initializer)
-	|| (c->ts.type == BT_DERIVED
-	    && (!c->attr.pointer && has_default_initializer (c->ts.u.derived))))
-      break;
-
-  return c != NULL;
-}
-
 /* Resolve common variables.  */
 static void
 resolve_common_vars (gfc_symbol *sym, bool named_common)
@@ -751,7 +736,7 @@ resolve_common_vars (gfc_symbol *sym, bo
 	gfc_error_now ("Derived type variable '%s' in COMMON at %L "
 		       "has an ultimate component that is "
 		       "allocatable", csym->name, &csym->declared_at);
-      if (has_default_initializer (csym->ts.u.derived))
+      if (gfc_has_default_initializer (csym->ts.u.derived))
 	gfc_error_now ("Derived type variable '%s' in COMMON at %L "
 		       "may not have default initializer", csym->name,
 		       &csym->declared_at);
@@ -8018,7 +8003,7 @@ resolve_ordinary_assign (gfc_code *code,
 	 and rhs is the same symbol as the lhs.  */
       if ((*rhsptr)->expr_type == EXPR_VARIABLE
 	    && (*rhsptr)->symtree->n.sym->ts.type == BT_DERIVED
-	    && has_default_initializer ((*rhsptr)->symtree->n.sym->ts.u.derived)
+	    && gfc_has_default_initializer ((*rhsptr)->symtree->n.sym->ts.u.derived)
 	    && (lhs->symtree->n.sym == (*rhsptr)->symtree->n.sym))
 	*rhsptr = gfc_get_parentheses (*rhsptr);
 
@@ -9143,13 +9128,13 @@ resolve_fl_variable_derived (gfc_symbol 
      or POINTER attribute, the object shall have the SAVE attribute."
 
      The check for initializers is performed with
-     has_default_initializer because gfc_default_initializer generates
+     gfc_has_default_initializer because gfc_default_initializer generates
      a hidden default for allocatable components.  */
   if (!(sym->value || no_init_flag) && sym->ns->proc_name
       && sym->ns->proc_name->attr.flavor == FL_MODULE
       && !sym->ns->save_all && !sym->attr.save
       && !sym->attr.pointer && !sym->attr.allocatable
-      && has_default_initializer (sym->ts.u.derived)
+      && gfc_has_default_initializer (sym->ts.u.derived)
       && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Implied SAVE for "
 			 "module variable '%s' at %L, needed due to "
 			 "the default initialization", sym->name,
@@ -12201,7 +12186,7 @@ resolve_equivalence_derived (gfc_symbol 
       return FAILURE;
     }
 
-  if (sym->attr.in_common && has_default_initializer (sym->ts.u.derived))
+  if (sym->attr.in_common && gfc_has_default_initializer (sym->ts.u.derived))
     {
       gfc_error ("Derived type variable '%s' at %L with default "
 		 "initialization cannot be in EQUIVALENCE with a variable "
Index: trans-array.c
===================================================================
--- trans-array.c	(revision 159179)
+++ trans-array.c	(working copy)
@@ -6222,25 +6222,6 @@ gfc_copy_only_alloc_comp (gfc_symbol * d
 }
 
 
-/* Check for default initializer; sym->value is not enough as it is also
-   set for EXPR_NULL of allocatables.  */
-
-static bool
-has_default_initializer (gfc_symbol *der)
-{
-  gfc_component *c;
-
-  gcc_assert (der->attr.flavor == FL_DERIVED);
-  for (c = der->components; c; c = c->next)
-    if ((c->ts.type != BT_DERIVED && c->initializer)
-        || (c->ts.type == BT_DERIVED
-            && (!c->attr.pointer && has_default_initializer (c->ts.u.derived))))
-      break;
-
-  return c != NULL;
-}
-
-
 /* NULLIFY an allocatable/pointer array on function entry, free it on exit.
    Do likewise, recursively if necessary, with the allocatable components of
    derived types.  */
@@ -6307,7 +6288,8 @@ gfc_trans_deferred_array (gfc_symbol * s
       if (!sym->attr.save
 	  && !(TREE_STATIC (sym->backend_decl) && sym->attr.is_main_program))
 	{
-	  if (sym->value == NULL || !has_default_initializer (sym->ts.u.derived))
+	  if (sym->value == NULL
+	      || !gfc_has_default_initializer (sym->ts.u.derived))
 	    {
 	      rank = sym->as ? sym->as->rank : 0;
 	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);
Index: trans-decl.c
===================================================================
--- trans-decl.c	(revision 159179)
+++ trans-decl.c	(working copy)
@@ -3838,10 +3838,14 @@ generate_local_decl (gfc_symbol * sym)
 	       && sym->attr.dummy
 	       && sym->attr.intent == INTENT_OUT)
 	{
-	  if (!(sym->ts.type == BT_DERIVED
-		&& sym->ts.u.derived->components->initializer))
+	  if (sym->ts.type != BT_DERIVED)
 	    gfc_warning ("Dummy argument '%s' at %L was declared INTENT(OUT) "
 		         "but was not set",  sym->name, &sym->declared_at);
+	  else if (!gfc_has_default_initializer (sym->ts.u.derived))
+	    gfc_warning ("Derived-type dummy argument '%s' at %L was "
+			 "declared INTENT(OUT) but was not set and does "
+			 "not have a default initializer",
+			 sym->name, &sym->declared_at);
 	}
       /* Specific warning for unused dummy arguments. */
       else if (warn_unused_variable && sym->attr.dummy)