1! { dg-do compile }
2!
3! PR fortran/52469
4!
5! This was failing as the DECL of the proc pointer "func"
6! was used for the interface of the proc-pointer component "my_f_ptr"
7! rather than the decl of the proc-pointer target
8!
9! Contributed by palott@gmail.com
10!
11
12module ExampleFuncs
13  implicit none
14
15  ! NOTE: "func" is a procedure pointer!
16  pointer :: func
17  interface
18     function func (z)
19        real :: func
20        real, intent (in) :: z
21     end function func
22  end interface
23
24  type Contains_f_ptr
25     procedure (func), pointer, nopass :: my_f_ptr
26  end type Contains_f_ptr
27contains
28
29function f1 (x)
30  real :: f1
31  real, intent (in) :: x
32
33  f1 = 2.0 * x
34
35  return
36end function f1
37
38function f2 (x)
39   real :: f2
40   real, intent (in) :: x
41
42   f2 = 3.0 * x**2
43
44   return
45end function f2
46
47function fancy (func, x)
48   real :: fancy
49   real, intent (in) :: x
50
51   interface AFunc
52      function func (y)
53         real :: func
54         real, intent (in) ::y
55      end function func
56   end interface AFunc
57
58   fancy = func (x) + 3.3 * x
59end function fancy
60
61end module  ExampleFuncs
62
63
64program test_proc_ptr
65  use ExampleFuncs
66  implicit none
67
68  type (Contains_f_ptr), dimension (2) :: NewType
69
70  !NewType(1) % my_f_ptr => f1
71  NewType(2) % my_f_ptr => f2
72
73  !write (*, *) NewType(1) % my_f_ptr (3.0), NewType(2) % my_f_ptr (3.0)
74  write (6, *)  NewType(2) % my_f_ptr (3.0) ! < Shall print '27.0'
75
76  stop
77end program test_proc_ptr
78