gcc/fortran/:

2010-05-19  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-19  Daniel Franke  <franke.daniel@gmail.com>

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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159562 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b9a986e..771a263 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,18 @@
 2010-05-19  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.
+
+2010-05-19  Daniel Franke  <franke.daniel@gmail.com>
+
        PR fortran/38404
        * primary.c (match_string_constant): Move start_locus just inside 
        the string.

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 75f27be..6884c90 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3557,6 +3557,31 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue)
 }
 
 
+/* 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 *
@@ -3565,7 +3590,8 @@ gfc_default_initializer (gfc_typespec *ts)
   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;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c14bcce..903f05c 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2617,6 +2617,7 @@ gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int);
 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 *);
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d165bd6..e5a46fa 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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, bool named_common)
        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);
@@ -8056,7 +8041,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
         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);
 
@@ -9204,13 +9189,13 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
      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,
@@ -12245,7 +12230,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
       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 "

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a94c8d2..7f81cf1 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6223,25 +6223,6 @@ gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
 }
 
 
-/* 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.  */
@@ -6308,7 +6289,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
       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);

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e24390b..c523a5c 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3872,10 +3872,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)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f18f56f..12f4e3c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2010-05-19  Daniel Franke  <franke.daniel@gmail.com>
 
+       PR fortran/42360
+       * gfortran.dg/warn_intent_out_not_set.f90: New.
+
+2010-05-19  Daniel Franke  <franke.daniel@gmail.com>
+
        PR fortran/38404
        * gfortran.dg/data_char_1.f90: Updated warning message.
        * gfortran.dg/data_array_6.f: New.

diff --git a/gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90 b/gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90
new file mode 100644 (file)
index 0000000..52b2315
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90
@@ -0,0 +1,30 @@
+! { 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" } }