1! { dg-do run }
2!
3! PR 44936: [OOP] Generic TBP not resolved correctly at compile time
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 => doit1
12    procedure, pass(a) :: getit=> getit1
13    generic, public :: do  => doit
14    generic, public :: get => getit
15  end type foo
16  private doit1,getit1
17contains
18  subroutine  doit1(a)
19    class(foo) :: a
20    a%i = 1
21    write(*,*) 'FOO%DOIT base version'
22  end subroutine doit1
23  function getit1(a) result(res)
24    class(foo) :: a
25    integer :: res
26    res = a%i
27  end function getit1
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
39contains
40  subroutine  doit2(a)
41    class(foo2) :: a
42    a%i = 2
43    a%j = 3
44  end subroutine doit2
45  function getit2(a) result(res)
46    class(foo2) :: a
47    integer :: res
48    res = a%j
49  end function getit2
50end module foo2_mod
51
52program testd15
53  use foo2_mod
54  type(foo2) :: af2
55
56  call af2%do()
57  if (af2%i .ne. 2) call abort
58  if (af2%get() .ne. 3) call abort
59
60end program testd15
61 
62