diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/primary.c | 32 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 7 |
5 files changed, 40 insertions, 16 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2ca0e243122..0572b05868b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2009-11-26 Janus Weil <janus@gcc.gnu.org> + + PR fortran/42048 + PR fortran/42167 + * gfortran.h (gfc_is_function_return_value): New prototype. + * match.c (gfc_match_call): Use new function + 'gfc_is_function_return_value'. + * primary.c (gfc_is_function_return_value): New function to check if a + symbol is the return value of an encompassing function. + (match_actual_arg,gfc_match_rvalue,match_variable): Use new function + 'gfc_is_function_return_value'. + * resolve.c (resolve_common_blocks,resolve_actual_arglist): Ditto. + 2009-11-25 Jakub Jelinek <jakub@redhat.com> PR fortran/42162 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 74a31d2661c..cc3ccf5527c 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2751,6 +2751,7 @@ symbol_attribute gfc_expr_attr (gfc_expr *); match gfc_match_rvalue (gfc_expr **); match gfc_match_varspec (gfc_expr*, int, bool, bool); int gfc_check_digit (char, int); +bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *); /* trans.c */ void gfc_generate_code (gfc_namespace *); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 13f68ab8c65..f6650e78b52 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2975,7 +2975,8 @@ gfc_match_call (void) /* If this is a variable of derived-type, it probably starts a type-bound procedure call. */ - if ((sym->attr.flavor != FL_PROCEDURE || sym == gfc_current_ns->proc_name) + if ((sym->attr.flavor != FL_PROCEDURE + || gfc_is_function_return_value (sym, gfc_current_ns)) && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)) return match_typebound_call (st); diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index c0777c48b85..113729fb059 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1347,6 +1347,25 @@ gfc_match_literal_constant (gfc_expr **result, int signflag) } +/* This checks if a symbol is the return value of an encompassing function. + Function nesting can be maximally two levels deep, but we may have + additional local namespaces like BLOCK etc. */ + +bool +gfc_is_function_return_value (gfc_symbol *sym, gfc_namespace *ns) +{ + if (!sym->attr.function || (sym->result != sym)) + return false; + while (ns) + { + if (ns->proc_name == sym) + return true; + ns = ns->parent; + } + return false; +} + + /* Match a single actual argument value. An actual argument is usually an expression, but can also be a procedure name. If the argument is a single name, it is not always possible to tell @@ -1415,9 +1434,7 @@ match_actual_arg (gfc_expr **result) is being defined, then we have a variable. */ if (sym->attr.function && sym->result == sym) { - if (gfc_current_ns->proc_name == sym - || (gfc_current_ns->parent != NULL - && gfc_current_ns->parent->proc_name == sym)) + if (gfc_is_function_return_value (sym, gfc_current_ns)) break; if (sym->attr.entry @@ -2521,9 +2538,7 @@ gfc_match_rvalue (gfc_expr **result) return MATCH_ERROR; } - if (gfc_current_ns->proc_name == sym - || (gfc_current_ns->parent != NULL - && gfc_current_ns->parent->proc_name == sym)) + if (gfc_is_function_return_value (sym, gfc_current_ns)) goto variable; if (sym->attr.entry @@ -2998,10 +3013,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) if (sym->attr.function && !sym->attr.external && sym->result == sym - && ((sym == gfc_current_ns->proc_name - && sym == gfc_current_ns->proc_name->result) - || (gfc_current_ns->parent - && sym == gfc_current_ns->parent->proc_name->result) + && (gfc_is_function_return_value (sym, gfc_current_ns) || (sym->attr.entry && sym->ns == gfc_current_ns) || (sym->attr.entry diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 740679edd2d..5048f251528 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -776,7 +776,7 @@ resolve_common_blocks (gfc_symtree *common_root) gfc_error ("COMMON block '%s' at %L is also an intrinsic procedure", sym->name, &common_root->n.common->where); else if (sym->attr.result - ||(sym->attr.function && gfc_current_ns->proc_name == sym)) + || gfc_is_function_return_value (sym, gfc_current_ns)) gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' at %L " "that is also a function result", sym->name, &common_root->n.common->where); @@ -1400,10 +1400,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, /* If the symbol is the function that names the current (or parent) scope, then we really have a variable reference. */ - if (sym->attr.function && sym->result == sym - && (sym->ns->proc_name == sym - || (sym->ns->parent != NULL - && sym->ns->parent->proc_name == sym))) + if (gfc_is_function_return_value (sym, sym->ns)) goto got_variable; /* If all else fails, see if we have a specific intrinsic. */ |