1! { dg-do run }
2!
3! PR39630: Fortran 2003: Procedure pointer components.
4!
5! Basic test for PPCs with SUBROUTINE interface and NOPASS.
6!
7! Contributed by Janus Weil <janus@gcc.gnu.org>
8
9  type t
10    integer :: i
11    procedure(sub), pointer, nopass :: ppc
12    procedure(), pointer, nopass :: proc
13  end type
14
15  type, extends(t) :: t2
16    procedure(), pointer, nopass :: proc2
17  end type t2
18
19  type(t) :: x
20  type(t2) :: x2
21
22  procedure(sub),pointer :: pp
23  integer :: sum = 0
24
25  x%i = 1
26  x%ppc => sub
27  pp => x%ppc
28
29  call sub(1)
30  if (sum/=1) call abort
31  call pp(2)
32  if (sum/=3) call abort
33  call x%ppc(3)
34  if (sum/=6) call abort
35
36  ! calling object as argument
37  x%proc => sub2
38  call x%proc(x)
39  if (x%i/=7) call abort
40
41  ! type extension
42  x%proc => sub
43  call x%proc(4)
44  if (sum/=10) call abort
45  x2%proc => sub
46  call x2%proc(5)
47  if (sum/=15) call abort
48  x2%proc2 => sub
49  call x2%proc2(6)
50  if (sum/=21) call abort
51
52contains
53
54  subroutine sub(y)
55    integer, intent(in) :: y
56    sum = sum + y
57  end subroutine
58
59  subroutine sub2(arg)
60    type(t),intent(inout) :: arg
61    arg%i = arg%i + sum
62  end subroutine
63
64end
65
66