gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_1.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 39630: [F03] Procedure Pointer Components with PASS
   4 !
   5 ! found at http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/4a827e8ced6efb0f/884b9eca6d7e6742
   6
   7 module mymod
   8
   9     type :: mytype
  10         integer :: i
  11         procedure(set_int_value), pointer :: seti
  12     end type
  13
  14     abstract interface
  15         subroutine set_int_value(this,i)
  16             import
  17             class(mytype), intent(inout) :: this
  18             integer, intent(in) :: i
  19         end subroutine set_int_value
  20     end interface
  21
  22     contains
  23
  24     subroutine seti_proc(this,i)
  25         class(mytype), intent(inout) :: this
  26         integer, intent(in) :: i
  27         this%i=i
  28     end subroutine seti_proc
  29
  30 end module mymod
  31
  32 program Test_03
  33     use mymod
  34     implicit none
  35
  36     type(mytype) :: m
  37
  38     m%i = 44
  39     m%seti => seti_proc
  40
  41     call m%seti(6)
  42
  43     if (m%i/=6) call abort()
  44
  45 end program Test_03