1! { dg-do run }
2!
3! PR 47565: [4.6 Regression][OOP] Segfault with TBP
4!
5! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
6
7module class_t
8  type :: t
9    procedure(find_y), pointer, nopass :: ppc
10  contains
11    procedure, nopass :: find_y
12  end type
13  integer, private :: count = 0
14contains
15  function find_y() result(res)
16    integer, allocatable :: res
17    allocate(res)
18    count = count + 1
19    res = count
20  end function
21end module
22
23program p
24  use class_t
25  class(t), allocatable :: this
26  integer :: y
27
28  allocate(this)
29  this%ppc => find_y
30  ! (1) ordinary procedure
31  y = find_y()
32  if (y/=1) call abort()
33  ! (2) procedure pointer component
34  y = this%ppc()
35  if (y/=2) call abort()
36  ! (3) type-bound procedure
37  y = this%find_y()
38  if (y/=3) call abort()
39end 
40