Commit 4e5d3db2 by Janus Weil

re PR fortran/50659 ([F03] ICE with PROCEDURE statement)

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-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/50659
	* gfortran.dg/proc_decl_27.f90: New.

From-SVN: r179723
parent 3bb4db67
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> 2011-10-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/47844 PR fortran/47844
......
...@@ -4134,8 +4134,9 @@ gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict) ...@@ -4134,8 +4134,9 @@ gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict)
return error_found ? FAILURE : SUCCESS; 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. */ statements. The boolean return value is required by gfc_traverse_expr. */
static bool static bool
...@@ -4144,14 +4145,12 @@ replace_symbol (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED) ...@@ -4144,14 +4145,12 @@ replace_symbol (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED)
if ((expr->expr_type == EXPR_VARIABLE if ((expr->expr_type == EXPR_VARIABLE
|| (expr->expr_type == EXPR_FUNCTION || (expr->expr_type == EXPR_FUNCTION
&& !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where))) && !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_symtree *root = sym->formal_ns ? sym->formal_ns->sym_root
gfc_namespace *ns = sym->formal_ns; : gfc_current_ns->sym_root;
/* Don't use gfc_get_symtree as we prefer to fail badly if we don't find gfc_symtree *stree = gfc_find_symtree (root, expr->symtree->n.sym->name);
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);
gcc_assert (stree); gcc_assert (stree);
stree->n.sym->attr = expr->symtree->n.sym->attr; stree->n.sym->attr = expr->symtree->n.sym->attr;
expr->symtree = stree; expr->symtree = stree;
...@@ -4165,6 +4164,7 @@ gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest) ...@@ -4165,6 +4164,7 @@ gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest)
gfc_traverse_expr (expr, dest, &replace_symbol, 0); gfc_traverse_expr (expr, dest, &replace_symbol, 0);
} }
/* The following is analogous to 'replace_symbol', and needed for copying /* The following is analogous to 'replace_symbol', and needed for copying
interfaces for procedure pointer components. The argument 'sym' must formally 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. be a gfc_symbol, so that the function can be passed to gfc_traverse_expr.
......
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> 2011-10-08 Nicola Pero <nicola.pero@meta-innovation.com>
PR libobjc/50428 PR libobjc/50428
......
! { 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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment