gcc/testsuite/gfortran.dg/typebound_call_20.f03

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