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
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;
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.
--- /dev/null
+! { 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" } }