From 2d300fac7d9aaaa9f5cb63a44b3cfc130895324d Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 18 Jan 2011 23:40:33 +0100 Subject: [PATCH] re PR fortran/47240 ([F03] segfault with procedure pointer component) 2011-01-18 Janus Weil 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 PR fortran/47240 * gfortran.dg/proc_ptr_comp_29.f90: New. From-SVN: r168973 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/resolve.c | 4 +++ gcc/fortran/trans-expr.c | 5 ++-- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/proc_ptr_comp_29.f90 | 25 +++++++++++++++++++ 5 files changed, 44 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 50492ccbef8..8bf90a95b04 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-01-18 Janus Weil + + 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 PR fortran/47331 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ed39e78d9b5..f2e722320dd 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 42e259354d1..ec1e848509c 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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)) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2ee28609ffe..9c3e8ba99d0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-01-18 Janus Weil + + PR fortran/47240 + * gfortran.dg/proc_ptr_comp_29.f90: New. + 2011-01-18 Dominique d'Humieres PR testsuite/41146 diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90 new file mode 100644 index 00000000000..94c59cd1a3b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! +! PR 47240: [F03] segfault with procedure pointer component +! +! Contributed by Martien Hulsen + + 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