+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
}
+/* 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 *
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;
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 *);
}
-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)
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);
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);
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,
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 "
}
-/* 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. */
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);
&& 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)
+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
--- /dev/null
+! { 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" } }