view gcc/testsuite/gfortran.dg/typebound_call_20.f03 @ 118:fd00160c1b76

ifdef TARGET_64BIT
author mir3636
date Tue, 27 Feb 2018 15:01:35 +0900
parents 04ced10e8804
children 84e7813d76e9
line wrap: on
line source

! { dg-do run }
! { dg-require-visibility "" }
!
! 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