OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Janus Weil 2011-10-09 13:34:21 +02:00
parent 3bb4db675a
commit 4e5d3db2c4
4 changed files with 44 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -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

18
gcc/fortran/expr.c
View File

@ -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.

5
gcc/testsuite/ChangeLog
View File

@ -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

25
gcc/testsuite/gfortran.dg/proc_decl_27.f90 Normal file
View File

@ -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" } }