+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.
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))
--- /dev/null
+! { 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" }}