re PR fortran/42360 (intent(out)-dummy-not-set warning for types depends on order of component initializers)
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. From-SVN: r159562
This commit is contained in:
parent
66faed7643
commit
16e520b612
8 changed files with 89 additions and 43 deletions
|
@ -1,3 +1,16 @@
|
|||
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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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 *);
|
||||
|
||||
|
|
|
@ -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 "
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
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
|
||||
|
|
30
gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90
Normal file
30
gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90
Normal file
|
@ -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" } }
|
Loading…
Add table
Reference in a new issue