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:
parent
d2cd871faa
commit
2d300fac7d
|
@ -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>
|
2011-01-17 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
PR fortran/47331
|
PR fortran/47331
|
||||||
|
|
|
@ -4863,6 +4863,10 @@ expression_rank (gfc_expr *e)
|
||||||
|
|
||||||
for (ref = e->ref; ref; ref = ref->next)
|
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)
|
if (ref->type != REF_ARRAY)
|
||||||
continue;
|
continue;
|
||||||
|
|
||||||
|
|
|
@ -3043,8 +3043,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
||||||
&& fsym->attr.flavor != FL_PROCEDURE)
|
&& fsym->attr.flavor != FL_PROCEDURE)
|
||||||
|| (fsym->attr.proc_pointer
|
|| (fsym->attr.proc_pointer
|
||||||
&& !(e->expr_type == EXPR_VARIABLE
|
&& !(e->expr_type == EXPR_VARIABLE
|
||||||
&& e->symtree->n.sym->attr.dummy))
|
&& e->symtree->n.sym->attr.dummy))
|
||||||
|| (e->expr_type == EXPR_VARIABLE
|
|| (fsym->attr.proc_pointer
|
||||||
|
&& e->expr_type == EXPR_VARIABLE
|
||||||
&& gfc_is_proc_ptr_comp (e, NULL))
|
&& gfc_is_proc_ptr_comp (e, NULL))
|
||||||
|| fsym->attr.allocatable))
|
|| fsym->attr.allocatable))
|
||||||
{
|
{
|
||||||
|
|
|
@ -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>
|
2011-01-18 Dominique d'Humieres <dominiq@lps.ens.fr>
|
||||||
|
|
||||||
PR testsuite/41146
|
PR testsuite/41146
|
||||||
|
|
|
@ -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
|
Loading…
Reference in New Issue