1! { dg-do run }
2! Tests the fix for PR41648 in which the reference a%a%getit () was wrongly
3! identified as a recursive call to getit.
4!
5! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
6!
7module foo_mod
8  type foo
9    integer :: i
10  contains
11    procedure, pass(a) :: doit
12    procedure, pass(a) :: getit
13  end type foo
14
15  private doit,getit
16contains
17  subroutine  doit(a)
18    class(foo) :: a
19
20    a%i = 1
21  end subroutine doit
22  function getit(a) result(res)
23    class(foo) :: a
24    integer :: res
25
26    res = a%i
27  end function getit
28
29end module foo_mod
30
31module s_bar_mod
32  use foo_mod
33  type, extends(foo) :: s_bar
34    type(foo), allocatable :: a
35  contains
36    procedure, pass(a) :: doit
37    procedure, pass(a) :: getit
38  end type s_bar
39  private doit,getit
40
41contains
42  subroutine doit(a)
43    class(s_bar) :: a
44    allocate (a%a)
45    call a%a%doit()
46  end subroutine doit
47  function getit(a) result(res)
48    class(s_bar) :: a
49    integer :: res
50
51    res = a%a%getit () * 2
52  end function getit
53end module s_bar_mod
54
55module a_bar_mod
56  use foo_mod
57  type, extends(foo) :: a_bar
58    type(foo), allocatable :: a(:)
59  contains
60    procedure, pass(a) :: doit
61    procedure, pass(a) :: getit
62  end type a_bar
63  private doit,getit
64
65contains
66  subroutine doit(a)
67    class(a_bar) :: a
68    allocate (a%a(1))
69    call a%a(1)%doit ()
70  end subroutine doit
71  function getit(a) result(res)
72    class(a_bar) :: a
73    integer :: res
74
75    res = a%a(1)%getit () * 3
76  end function getit
77end module a_bar_mod
78
79  use s_bar_mod
80  use a_bar_mod
81  type(foo), target :: b
82  type(s_bar), target :: c
83  type(a_bar), target :: d
84  class(foo), pointer :: a
85  a => b
86  call a%doit
87  if (a%getit () .ne. 1) STOP 1
88  a => c
89  call a%doit
90  if (a%getit () .ne. 2) STOP 2
91  a => d
92  call a%doit
93  if (a%getit () .ne. 3) STOP 3
94end
95