gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_3.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 39630: [F03] Procedure Pointer Components with PASS
   4 !
   5 ! taken from "Fortran 95/2003 explained" (Metcalf, Reid, Cohen, 2004)
   6
   7 type t
   8   procedure(obp), pointer, pass(x) :: p
   9   character(100) :: name
  10 end type
  11
  12 abstract interface
  13   subroutine obp(w,x)
  14     import :: t
  15     integer :: w
  16     class(t) :: x
  17   end subroutine
  18 end interface
  19
  20 type(t) :: a
  21 a%p => my_obp_sub
  22 a%name = "doodoo"
  23
  24 call a%p(32)
  25
  26 contains
  27
  28   subroutine my_obp_sub(w,x)
  29     integer :: w
  30     class(t) :: x
  31     if (x%name/="doodoo") call abort()
  32     if (w/=32) call abort()
  33   end subroutine
  34
  35 end
  36