1! { dg-do run } 2! Tests the fix for PR42104 in which the call to the procedure pointer 3! component caused an ICE because the "always_implicit flag was not used 4! to force the passing of a descriptor for the array argument. 5! 6! Contributed by Martien Hulsen <m.a.hulsen@tue.nl> 7! 8module poisson_functions_m 9 10 implicit none 11 12contains 13 14 function func ( nr, x ) 15 integer, intent(in) :: nr 16 real, intent(in), dimension(:) :: x 17 real :: func 18 19 real :: pi 20 21 pi = 4 * atan(1.) 22 23 select case(nr) 24 case(1) 25 func = 0 26 case(2) 27 func = 1 28 case(3) 29 func = 1 + cos(pi*x(1))*cos(pi*x(2)) 30 case default 31 write(*,'(/a,i0/)') 'Error func: wrong function number: ', nr 32 stop 33 end select 34 35 end function func 36 37end module poisson_functions_m 38 39module element_defs_m 40 41 implicit none 42 43 abstract interface 44 function dummyfunc ( nr, x ) 45 integer, intent(in) :: nr 46 real, intent(in), dimension(:) :: x 47 real :: dummyfunc 48 end function dummyfunc 49 end interface 50 51 type function_p 52 procedure(dummyfunc), nopass, pointer :: p => null() 53 end type function_p 54 55end module element_defs_m 56 57program t 58 59use poisson_functions_m 60use element_defs_m 61 62procedure(dummyfunc), pointer :: p => null() 63type(function_p) :: funcp 64 65p => func 66funcp%p => func 67 68print *, func(nr=3,x=(/0.1,0.1/)) 69print *, p(nr=3,x=(/0.1,0.1/)) 70print *, funcp%p(nr=3,x=(/0.1,0.1/)) 71 72end program t 73