1! { dg-do run }
2!
3! PR 43945: [OOP] Derived type with GENERIC: resolved to the wrong specific TBP
4!
5! Contributed by 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    generic, public :: do  => doit
14    generic, public :: get => getit
15  end type foo
16  private doit,getit
17contains
18  subroutine  doit(a)
19    class(foo) :: a
20    a%i = 1
21    write(*,*) 'FOO%DOIT base version'
22  end subroutine doit
23  function getit(a) result(res)
24    class(foo) :: a
25    integer :: res
26    res = a%i
27  end function getit
28end module foo_mod
29
30module foo2_mod
31  use foo_mod
32  type, extends(foo) :: foo2
33    integer :: j
34  contains
35    procedure, pass(a) :: doit  => doit2
36    procedure, pass(a) :: getit => getit2
37  end type foo2
38  private doit2, getit2
39
40contains
41
42  subroutine  doit2(a)
43    class(foo2) :: a
44    a%i = 2
45    a%j = 3
46  end subroutine doit2
47  function getit2(a) result(res)
48    class(foo2) :: a
49    integer :: res
50    res = a%j
51  end function getit2
52end module foo2_mod
53
54program testd15
55  use foo2_mod
56  type(foo2) :: af2
57  class(foo), allocatable :: afab
58
59  allocate(foo2 :: afab)
60  call af2%do()
61  if (af2%i .ne. 2) STOP 1
62  if (af2%get() .ne. 3) STOP 2
63  call afab%do()
64  if (afab%i .ne. 2) STOP 3
65  if (afab%get() .ne. 3) STOP 4
66
67end program testd15
68