diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 28 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 25 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 22 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 8 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90 | 30 |
8 files changed, 89 insertions, 43 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b9a986e..771a263 100644 --- 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 --- 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 --- 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 d165bd66..e5a46fa 100644 --- 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 --- 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 --- 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 --- 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 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" } } |