1! { dg-do run }
2! Test the fix for PR43945 in which the over-ridding of 'doit' and
3! 'getit' in type 'foo2' was missed in the specific binding to 'do' and 'get'.
4!
5! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
6! and reported to clf by Salvatore Filippone <sfilippone@uniroma2.it>
7!
8module foo_mod
9  type foo
10    integer :: i
11  contains
12    procedure, pass(a) :: doit
13    procedure, pass(a) :: getit
14    generic, public :: do  => doit
15    generic, public :: get => getit
16  end type foo
17  private doit,getit
18contains
19  subroutine  doit(a)
20    class(foo) :: a
21    a%i = 1
22    write(*,*) 'FOO%DOIT base version'
23  end subroutine doit
24  function getit(a) result(res)
25    class(foo) :: a
26    integer :: res
27    res = a%i
28  end function getit
29end module foo_mod
30
31module foo2_mod
32  use foo_mod
33  type, extends(foo) :: foo2
34    integer :: j
35  contains
36    procedure, pass(a) :: doit  => doit2
37    procedure, pass(a) :: getit => getit2
38!!$    generic, public :: do  => doit
39!!$    generic, public :: get => getit
40  end type foo2
41  private doit2, getit2
42
43contains
44
45  subroutine  doit2(a)
46    class(foo2) :: a
47    a%i = 2
48    a%j = 3
49  end subroutine doit2
50  function getit2(a) result(res)
51    class(foo2) :: a
52    integer :: res
53    res = a%j
54  end function getit2
55end module foo2_mod
56
57program testd15
58  use foo2_mod
59  type(foo2) :: af2
60
61  call af2%do()
62  if (af2%i .ne. 2) STOP 1
63  if (af2%get() .ne. 3) STOP 2
64
65end program testd15
66