diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2008-11-01 14:24:03 +0100 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2008-11-01 14:24:03 +0100 |
| commit | c6acea9d4fd505ca611df1f8b248bbbecaa4fef6 (patch) | |
| tree | 3bdd5ff69b6c21e149a0a9da51fcbf7311b75671 /gcc/fortran/expr.c | |
| parent | 002bd9f0ac7a90a1c0ed1488033505758df6c8df (diff) | |
| download | gcc-c6acea9d4fd505ca611df1f8b248bbbecaa4fef6.zip gcc-c6acea9d4fd505ca611df1f8b248bbbecaa4fef6.tar.gz gcc-c6acea9d4fd505ca611df1f8b248bbbecaa4fef6.tar.bz2 | |
re PR fortran/36322 (ICE with PROCEDURE using a complicated interface)
2008-11-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/36322
PR fortran/36463
* gfortran.h: New function gfc_expr_replace_symbols.
* decl.c (match_procedure_decl): Increase reference count for interface.
* expr.c: New functions replace_symbol and gfc_expr_replace_symbols.
* resolve.c (resolve_symbol): Correctly copy array spec and char len
of PROCEDURE declarations from their interface.
* symbol.c (gfc_get_default_type): Enhanced error message.
(copy_formal_args): Call copy_formal_args recursively for arguments.
* trans-expr.c (gfc_conv_function_call): Bugfix.
2008-11-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/36322
PR fortran/36463
* gfortran.dg/proc_decl_17.f90: New.
* gfortran.dg/proc_decl_18.f90: New.
From-SVN: r141515
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 25 |
1 files changed, 25 insertions, 0 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 1a5e6db..2cebb65 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3502,3 +3502,28 @@ gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict) return error_found ? FAILURE : SUCCESS; } + +/* Walk an expression tree and replace all symbols with a corresponding symbol + in the formal_ns of "sym". Needed for copying interfaces in PROCEDURE + statements. The boolean return value is required by gfc_traverse_expr. */ + +static bool +replace_symbol (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED) +{ + if ((expr->expr_type == EXPR_VARIABLE || expr->expr_type == EXPR_FUNCTION) + && expr->symtree->n.sym->ns != sym->formal_ns + && expr->symtree->n.sym->attr.dummy) + { + gfc_symtree *stree; + gfc_get_sym_tree (expr->symtree->name, sym->formal_ns, &stree); + stree->n.sym->attr.referenced = expr->symtree->n.sym->attr.referenced; + expr->symtree = stree; + } + return false; +} + +void +gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest) +{ + gfc_traverse_expr (expr, dest, &replace_symbol, 0); +} |