diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 26 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 30 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 22 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 11 |
4 files changed, 80 insertions, 9 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 48d4334..449f9b8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,29 @@ +2007-03-15 Tobias Burnus <burnus@gcc.gnu.org> + Paul Thomas <pault@gcc.gnu.org> + + PR fortran/30922 + * decl.c (gfc_match_import): If the parent of the current name- + space is null, try looking for an imported symbol in the parent + of the proc_name interface. + * resolve.c (resolve_fl_variable): Do not check for blocking of + host association by a same symbol, if the symbol is in an + interface body. + +2007-03-15 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/30879 + * decl.c (match_data_constant): Before going on to try to match + a name, try to match a structure component. + + + PR fortran/30870 + * resolve.c (resolve_actual_arglist): Do not reject a generic + actual argument if it has a same name specific interface. + + PR fortran/31163 + * trans-array.c (parse_interface): Do not nullify allocatable + components if the symbol has the saved attribute. + 2007-03-14 Francois-Xavier Coudert <coudert@clipper.ens.fr> * trans-array.c (gfc_trans_auto_array_allocation): Replace diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 173ad45..09ded01 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -301,6 +301,7 @@ match_data_constant (gfc_expr **result) gfc_symbol *sym; gfc_expr *expr; match m; + locus old_loc; m = gfc_match_literal_constant (&expr, 1); if (m == MATCH_YES) @@ -316,6 +317,23 @@ match_data_constant (gfc_expr **result) if (m != MATCH_NO) return m; + old_loc = gfc_current_locus; + + /* Should this be a structure component, try to match it + before matching a name. */ + m = gfc_match_rvalue (result); + if (m == MATCH_ERROR) + return m; + + if (m == MATCH_YES && (*result)->expr_type == EXPR_STRUCTURE) + { + if (gfc_simplify_expr (*result, 0) == FAILURE) + m = MATCH_ERROR; + return m; + } + + gfc_current_locus = old_loc; + m = gfc_match_name (name); if (m != MATCH_YES) return m; @@ -2041,7 +2059,17 @@ gfc_match_import (void) switch (m) { case MATCH_YES: - if (gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym)) + if (gfc_current_ns->parent != NULL + && gfc_find_symbol (name, gfc_current_ns->parent, + 1, &sym)) + { + gfc_error ("Type name '%s' at %C is ambiguous", name); + return MATCH_ERROR; + } + else if (gfc_current_ns->proc_name->ns->parent != NULL + && gfc_find_symbol (name, + gfc_current_ns->proc_name->ns->parent, + 1, &sym)) { gfc_error ("Type name '%s' at %C is ambiguous", name); return MATCH_ERROR; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 987d73b..db55c0c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -922,11 +922,24 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype) &e->where); } + /* Check if a generic interface has a specific procedure + with the same name before emitting an error. */ if (sym->attr.generic) { - gfc_error ("GENERIC non-INTRINSIC procedure '%s' is not " - "allowed as an actual argument at %L", sym->name, - &e->where); + gfc_interface *p; + for (p = sym->generic; p; p = p->next) + if (strcmp (sym->name, p->sym->name) == 0) + { + e->symtree = gfc_find_symtree + (p->sym->ns->sym_root, sym->name); + sym = p->sym; + break; + } + + if (p == NULL || e->symtree == NULL) + gfc_error ("GENERIC non-INTRINSIC procedure '%s' is not " + "allowed as an actual argument at %L", sym->name, + &e->where); } /* If the symbol is the function that names the current (or @@ -5663,7 +5676,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) /* Check to see if a derived type is blocked from being host associated by the presence of another class I symbol in the same namespace. 14.6.1.3 of the standard and the discussion on comp.lang.fortran. */ - if (sym->ts.type == BT_DERIVED && sym->ns != sym->ts.derived->ns) + if (sym->ts.type == BT_DERIVED && sym->ns != sym->ts.derived->ns + && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY) { gfc_symbol *s; gfc_find_symbol (sym->ts.derived->name, sym->ns, 0, &s); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 5d41331..00e54c8 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5216,9 +5216,12 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body) if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable)) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank); - gfc_add_expr_to_block (&fnblock, tmp); + if (!sym->attr.save) + { + rank = sym->as ? sym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank); + gfc_add_expr_to_block (&fnblock, tmp); + } } else if (!GFC_DESCRIPTOR_TYPE_P (type)) { @@ -5239,7 +5242,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body) /* Allocatable arrays need to be freed when they go out of scope. The allocatable components of pointers must not be touched. */ if (sym_has_alloc_comp && !(sym->attr.function || sym->attr.result) - && !sym->attr.pointer) + && !sym->attr.pointer && !sym->attr.save) { int rank; rank = sym->as ? sym->as->rank : 0; |