gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_3.f90

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