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