gcc/testsuite/gfortran.dg/proc_ptr_comp_2.f90

   1 ! { dg-do run }
   2 !
   3 ! PR39630: Fortran 2003: Procedure pointer components.
   4 !
   5 ! Basic test for PPCs with FUNCTION interface and NOPASS.
   6 !
   7 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   8
   9   type t
  10     procedure(fcn), pointer, nopass :: ppc
  11     procedure(abstr), pointer, nopass :: ppc1
  12     integer :: i
  13   end type
  14
  15   abstract interface
  16     integer function abstr(x)
  17       integer, intent(in) :: x
  18     end function
  19   end interface
  20
  21   type(t) :: obj
  22   procedure(fcn), pointer :: f
  23   integer :: base
  24
  25   intrinsic :: iabs
  26
  27 ! Check with interface from contained function
  28   obj%ppc => fcn
  29   base=obj%ppc(2)
  30   if (base/=4) call abort
  31   call foo (obj%ppc,3)
  32
  33 ! Check with abstract interface
  34   obj%ppc1 => obj%ppc
  35   base=obj%ppc1(4)
  36   if (base/=8) call abort
  37   call foo (obj%ppc1,5)
  38
  39 ! Check compatibility components with non-components
  40   f => obj%ppc
  41   base=f(6)
  42   if (base/=12) call abort
  43   call foo (f,7)
  44
  45 contains
  46
  47   integer function fcn(x)
  48     integer, intent(in) :: x
  49     fcn = 2 * x
  50   end function
  51
  52   subroutine foo (arg, i)
  53     procedure (fcn), pointer :: arg
  54     integer :: i
  55     if (arg(i)/=2*i) call abort
  56   end subroutine
  57
  58 end