gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_5.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 39630: [F03] Procedure Pointer Components with PASS
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6
   7 module m
   8  type :: t
   9   sequence
  10   integer :: i
  11   procedure(foo), pointer,pass(y) :: foo
  12  end type t
  13 contains
  14  subroutine foo(x,y)
  15   type(t),optional :: x
  16   type(t) :: y
  17   if(present(x)) then
  18     print *, 'foo', x%i, y%i
  19     if (mod(x%i+y%i,3)/=2) call abort()
  20   else
  21     print *, 'foo', y%i
  22     if (mod(y%i,3)/=1) call abort()
  23   end if
  24  end subroutine foo
  25 end module m
  26
  27 use m
  28 type(t) :: t1, t2
  29 t1%i = 4
  30 t2%i = 7
  31 t1%foo => foo
  32 t2%foo => t1%foo
  33 call t1%foo()
  34 call t2%foo()
  35 call t2%foo(t1)
  36 end