1! { dg-do run }
2!
3! PR39630: Fortran 2003: Procedure pointer components.
4!
5! Basic test for PPCs with FUNCTION interface and NOPASS.
6!
7! Contributed by Janus Weil <janus@gcc.gnu.org>
8
9  type t
10    procedure(fcn), pointer, nopass :: ppc
11    procedure(abstr), pointer, nopass :: ppc1
12    integer :: i
13  end type
14
15  abstract interface
16    integer function abstr(x)
17      integer, intent(in) :: x
18    end function
19  end interface
20
21  type(t) :: obj
22  procedure(fcn), pointer :: f
23  integer :: base
24
25  intrinsic :: iabs
26
27! Check with interface from contained function
28  obj%ppc => fcn
29  base=obj%ppc(2)
30  if (base/=4) call abort
31  call foo (obj%ppc,3)
32
33! Check with abstract interface
34  obj%ppc1 => obj%ppc
35  base=obj%ppc1(4)
36  if (base/=8) call abort
37  call foo (obj%ppc1,5)
38
39! Check compatibility components with non-components
40  f => obj%ppc
41  base=f(6)
42  if (base/=12) call abort
43  call foo (f,7)
44
45contains
46
47  integer function fcn(x)
48    integer, intent(in) :: x
49    fcn = 2 * x
50  end function
51
52  subroutine foo (arg, i)
53    procedure (fcn), pointer :: arg
54    integer :: i
55    if (arg(i)/=2*i) call abort
56  end subroutine
57
58end
59