diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 5 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90 | 73 |
4 files changed, 91 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 95e761fb6e3..1d28abfebd4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2009-11-20 Paul Thomas <pault@gcc.gnu.org> + Janus Weil <janus@gcc.gnu.org> + + PR fortran/42104 + * trans-expr.c (gfc_conv_procedure_call): If procedure pointer + component call, use the component's 'always_explicit' attr + for array arguments. + 2009-11-19 Janus Weil <janus@gcc.gnu.org> * trans-expr.c (conv_isocbinding_procedure): New function. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index c0df6782750..6646b266a6d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2979,7 +2979,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, f = (fsym != NULL) && !(fsym->attr.pointer || fsym->attr.allocatable) && fsym->as->type != AS_ASSUMED_SHAPE; - f = f || !sym->attr.always_explicit; + if (comp) + f = f || !comp->attr.always_explicit; + else + f = f || !sym->attr.always_explicit; if (e->expr_type == EXPR_VARIABLE && is_subref_array (e)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ecebcb136a3..fdc14b95b5d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2009-11-20 Paul Thomas <pault@gcc.gnu.org> + Janus Weil <janus@gcc.gnu.org> + + PR fortran/42104 + * gfortran.dg/proc_ptr_comp_23.f90 : New test. + 2009-11-19 Jason Merrill <jason@redhat.com> PR c++/42115 diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90 new file mode 100644 index 00000000000..270d2c4ff46 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90 @@ -0,0 +1,73 @@ +! { dg-do run } +! Tests the fix for PR42104 in which the call to the procedure pointer +! component caused an ICE because the "always_implicit flag was not used +! to force the passing of a descriptor for the array argument. +! +! Contributed by Martien Hulsen <m.a.hulsen@tue.nl> +! +module poisson_functions_m + + implicit none + +contains + + function func ( nr, x ) + integer, intent(in) :: nr + real, intent(in), dimension(:) :: x + real :: func + + real :: pi + + pi = 4 * atan(1.) + + select case(nr) + case(1) + func = 0 + case(2) + func = 1 + case(3) + func = 1 + cos(pi*x(1))*cos(pi*x(2)) + case default + write(*,'(/a,i0/)') 'Error func: wrong function number: ', nr + stop + end select + + end function func + +end module poisson_functions_m + +module element_defs_m + + implicit none + + abstract interface + function dummyfunc ( nr, x ) + integer, intent(in) :: nr + real, intent(in), dimension(:) :: x + real :: dummyfunc + end function dummyfunc + end interface + + type function_p + procedure(dummyfunc), nopass, pointer :: p => null() + end type function_p + +end module element_defs_m + +program t + +use poisson_functions_m +use element_defs_m + +procedure(dummyfunc), pointer :: p => null() +type(function_p) :: funcp + +p => func +funcp%p => func + +print *, func(nr=3,x=(/0.1,0.1/)) +print *, p(nr=3,x=(/0.1,0.1/)) +print *, funcp%p(nr=3,x=(/0.1,0.1/)) + +end program t +! { dg-final { cleanup-modules "poisson_functions_m element_defs_m" }} |
