aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_20.f03
blob: 8ee7302c546471f151fc00f8c1e389567d421802 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
! { dg-do run }
!
! PR 47565: [4.6 Regression][OOP] Segfault with TBP
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>

module class_t
  type :: t
    procedure(find_y), pointer, nopass :: ppc
  contains
    procedure, nopass :: find_y
  end type
  integer, private :: count = 0
contains
  function find_y() result(res)
    integer, allocatable :: res
    allocate(res)
    count = count + 1
    res = count
  end function
end module

program p
  use class_t
  class(t), allocatable :: this
  integer :: y

  allocate(this)
  this%ppc => find_y
  ! (1) ordinary procedure
  y = find_y()
  if (y/=1) call abort()
  ! (2) procedure pointer component
  y = this%ppc()
  if (y/=2) call abort()
  ! (3) type-bound procedure
  y = this%find_y()
  if (y/=3) call abort()
end