gcc/testsuite/gfortran.dg/typebound_call_19.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 47455: [4.6 Regression][OOP] internal compiler error: in fold_convert_loc, at fold-const.c:2028
   4 !
   5 ! Contributed by Thomas Henlich <thenlich@users.sourceforge.net>
   6
   7 module class_t
   8   type :: tx
   9     integer :: i
  10   end type
  11   type :: t
  12     type(tx) :: x
  13     procedure(find_x), pointer :: ppc
  14   contains
  15     procedure :: find_x
  16   end type
  17   type(tx), target :: zero = tx(0)
  18 contains
  19   function find_x(this)
  20     class(t), intent(in) :: this
  21     type(tx), pointer :: find_x
  22     find_x => zero
  23   end function find_x
  24 end module
  25
  26 program test
  27   use class_t
  28   class(t),allocatable :: this
  29   procedure(find_x), pointer :: pp
  30   allocate(this)
  31   ! (1) ordinary function call
  32   zero = tx(1)
  33   this%x = find_x(this)
  34   if (this%x%i /= 1) call abort()
  35   ! (2) procedure pointer
  36   zero = tx(2)
  37   pp => find_x
  38   this%x = pp(this)
  39   if (this%x%i /= 2) call abort()
  40   ! (3) PPC
  41   zero = tx(3)
  42   this%ppc => find_x
  43   this%x = this%ppc()
  44   if (this%x%i /= 3) call abort()
  45    ! (4) TBP
  46   zero = tx(4)
  47   this%x = this%find_x()
  48   if (this%x%i /= 4) call abort()
  49 end
  50
  51 ! { dg-final { cleanup-modules "class_t" } }