gcc/testsuite/gfortran.dg/typebound_call_20.f03

   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
   7 module 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
  14 contains
  15   function find_y() result(res)
  16     integer, allocatable :: res
  17     allocate(res)
  18     count = count + 1
  19     res = count
  20   end function
  21 end module
  22
  23 program 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()
  39 end