re PR fortran/47240 ([F03] segfault with procedure pointer component)

2011-01-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47240
	* resolve.c (expression_rank): Fix rank of procedure poiner components.
	* trans-expr.c (gfc_conv_procedure_call): Take care of procedure
	pointer components as actual arguments.


2011-01-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47240
	* gfortran.dg/proc_ptr_comp_29.f90: New.

From-SVN: r168973
This commit is contained in:
Janus Weil 2011-01-18 23:40:33 +01:00
parent d2cd871faa
commit 2d300fac7d
5 changed files with 44 additions and 2 deletions

View File

@ -1,3 +1,10 @@
2011-01-18 Janus Weil <janus@gcc.gnu.org>
PR fortran/47240
* resolve.c (expression_rank): Fix rank of procedure poiner components.
* trans-expr.c (gfc_conv_procedure_call): Take care of procedure
pointer components as actual arguments.
2011-01-17 Jakub Jelinek <jakub@redhat.com>
PR fortran/47331

View File

@ -4863,6 +4863,10 @@ expression_rank (gfc_expr *e)
for (ref = e->ref; ref; ref = ref->next)
{
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.proc_pointer
&& ref->u.c.component->attr.function && !ref->next)
rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0;
if (ref->type != REF_ARRAY)
continue;

View File

@ -3043,8 +3043,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& fsym->attr.flavor != FL_PROCEDURE)
|| (fsym->attr.proc_pointer
&& !(e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.dummy))
|| (e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.dummy))
|| (fsym->attr.proc_pointer
&& e->expr_type == EXPR_VARIABLE
&& gfc_is_proc_ptr_comp (e, NULL))
|| fsym->attr.allocatable))
{

View File

@ -1,3 +1,8 @@
2011-01-18 Janus Weil <janus@gcc.gnu.org>
PR fortran/47240
* gfortran.dg/proc_ptr_comp_29.f90: New.
2011-01-18 Dominique d'Humieres <dominiq@lps.ens.fr>
PR testsuite/41146

View File

@ -0,0 +1,25 @@
! { dg-do run }
!
! PR 47240: [F03] segfault with procedure pointer component
!
! Contributed by Martien Hulsen <m.a.hulsen@tue.nl>
type t
procedure (fun), pointer, nopass :: p
end type
type(t) :: x
real, dimension(2) :: r
x%p => fun
r = evaluate (x%p)
if (r(1) /= 5 .and. r(2) /= 6) call abort()
contains
function fun ()
real, dimension(2) :: fun
fun = (/ 5, 6 /)
end function
function evaluate ( dummy )
real, dimension(2) :: evaluate
procedure(fun) :: dummy
evaluate = dummy ()
end function
end