gcc/testsuite/gfortran.dg/typebound_proc_23.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 49562: [4.6/4.7 Regression] [OOP] assigning value to type-bound function
   4 !
   5 ! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
   6
   7 module ice
   8   type::ice_type
   9    contains
  10      procedure::ice_func
  11   end type
  12   integer, target :: it = 0
  13 contains
  14   function ice_func(this)
  15     integer, pointer :: ice_func
  16     class(ice_type)::this
  17     ice_func => it
  18   end function ice_func
  19   subroutine ice_sub(a)
  20     class(ice_type)::a
  21     a%ice_func() = 1
  22   end subroutine ice_sub
  23 end module
  24
  25 use ice
  26 type(ice_type) :: t
  27 if (it/=0) call abort()
  28 call ice_sub(t)
  29 if (it/=1) call abort()
  30 end