diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/primary.c | 30 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 18 |
3 files changed, 31 insertions, 27 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7ab798d..fb4af7d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2005-01-22 Paul Brook <paul@codesourcery.com> + + * primary.c (gfc_match_rvalue): Only apply implicit type if variable + does not have an explicit type. + (gfc_match_variable): Resolve implicit derived types in all cases. + Resolve contained function types from their own namespace, not the + parent. + * resolve.c (resolve_contained_fntype): Remove duplicate sym->result + checking. Resolve from the contained namespace, not the parent. + 2005-01-22 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> PR fortran/19543 diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index da2b7c8..6496bcd 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2011,6 +2011,7 @@ gfc_match_rvalue (gfc_expr ** result) resolution phase. */ if (gfc_peek_char () == '%' + && sym->ts.type == BT_UNKNOWN && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, sym->ns); @@ -2188,29 +2189,18 @@ gfc_match_variable (gfc_expr ** result, int equiv_flag) case FL_UNKNOWN: if (gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE) return MATCH_ERROR; - - /* Special case for derived type variables that get their types - via an IMPLICIT statement. This can't wait for the - resolution phase. */ - - if (gfc_peek_char () == '%' - && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) - gfc_set_default_type (sym, 0, sym->ns); - break; case FL_PROCEDURE: /* Check for a nonrecursive function result */ if (sym->attr.function && (sym->result == sym || sym->attr.entry)) { - /* If a function result is a derived type, then the derived type may still have to be resolved. */ if (sym->ts.type == BT_DERIVED && gfc_use_derived (sym->ts.derived) == NULL) return MATCH_ERROR; - break; } @@ -2221,6 +2211,24 @@ gfc_match_variable (gfc_expr ** result, int equiv_flag) return MATCH_ERROR; } + /* Special case for derived type variables that get their types + via an IMPLICIT statement. This can't wait for the + resolution phase. */ + + { + gfc_namespace * implicit_ns; + + if (gfc_current_ns->proc_name == sym) + implicit_ns = gfc_current_ns; + else + implicit_ns = sym->ns; + + if (gfc_peek_char () == '%' + && sym->ts.type == BT_UNKNOWN + && gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED) + gfc_set_default_type (sym, 0, implicit_ns); + } + expr = gfc_get_expr (); expr->expr_type = EXPR_VARIABLE; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0e17c4b..c3bf350 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -259,27 +259,13 @@ resolve_contained_fntype (gfc_symbol * sym, gfc_namespace * ns) || sym->attr.flavor == FL_VARIABLE)) return; - /* Try to find out of what type the function is. If there was an - explicit RESULT clause, try to get the type from it. If the - function is never defined, set it to the implicit type. If - even that fails, give up. */ + /* Try to find out of what the return type is. */ if (sym->result != NULL) sym = sym->result; if (sym->ts.type == BT_UNKNOWN) { - /* Assume we can find an implicit type. */ - t = SUCCESS; - - if (sym->result == NULL) - t = gfc_set_default_type (sym, 0, ns); - else - { - if (sym->result->ts.type == BT_UNKNOWN) - t = gfc_set_default_type (sym->result, 0, NULL); - - sym->ts = sym->result->ts; - } + t = gfc_set_default_type (sym, 0, ns); if (t == FAILURE) gfc_error ("Contained function '%s' at %L has no IMPLICIT type", |