diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 18 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_decl_27.f90 | 25 |
4 files changed, 44 insertions, 9 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2c09f9a..8326a9f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-10-09 Janus Weil <janus@gcc.gnu.org> + + PR fortran/50659 + * expr.c (replace_symbol): Only do replacement if the symbol is a dummy. + 2011-10-08 Paul Thomas <pault@gcc.gnu.org> PR fortran/47844 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 397dcdc..8a09a28 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4134,8 +4134,9 @@ 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 + +/* Walk an expression tree and replace all dummy symbols by the 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 @@ -4144,14 +4145,12 @@ replace_symbol (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED) if ((expr->expr_type == EXPR_VARIABLE || (expr->expr_type == EXPR_FUNCTION && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where))) - && expr->symtree->n.sym->ns == sym->ts.interface->formal_ns) + && expr->symtree->n.sym->ns == sym->ts.interface->formal_ns + && expr->symtree->n.sym->attr.dummy) { - gfc_symtree *stree; - gfc_namespace *ns = sym->formal_ns; - /* Don't use gfc_get_symtree as we prefer to fail badly if we don't find - the symtree rather than create a new one (and probably fail later). */ - stree = gfc_find_symtree (ns ? ns->sym_root : gfc_current_ns->sym_root, - expr->symtree->n.sym->name); + gfc_symtree *root = sym->formal_ns ? sym->formal_ns->sym_root + : gfc_current_ns->sym_root; + gfc_symtree *stree = gfc_find_symtree (root, expr->symtree->n.sym->name); gcc_assert (stree); stree->n.sym->attr = expr->symtree->n.sym->attr; expr->symtree = stree; @@ -4165,6 +4164,7 @@ gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest) gfc_traverse_expr (expr, dest, &replace_symbol, 0); } + /* The following is analogous to 'replace_symbol', and needed for copying interfaces for procedure pointer components. The argument 'sym' must formally be a gfc_symbol, so that the function can be passed to gfc_traverse_expr. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 74ab912..c310ab2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-10-09 Janus Weil <janus@gcc.gnu.org> + + PR fortran/50659 + * gfortran.dg/proc_decl_27.f90: New. + 2011-10-08 Nicola Pero <nicola.pero@meta-innovation.com> PR libobjc/50428 diff --git a/gcc/testsuite/gfortran.dg/proc_decl_27.f90 b/gcc/testsuite/gfortran.dg/proc_decl_27.f90 new file mode 100644 index 0000000..30ff4de --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_decl_27.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! +! PR 50659: [4.5/4.6/4.7 Regression] [F03] ICE on invalid with procedure interface +! +! Contributed by Andrew Benson <abenson@caltech.edu> + +module m1 + integer :: arrSize +end module + +module m2 +contains + function Proc (arg) + use m1 + double precision, dimension(arrSize) :: proc + double precision :: arg + end function +end + + use m2 + implicit none + procedure(Proc) :: Proc_Get +end + +! { dg-final { cleanup-modules "m1 m2" } } |