gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_1.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 ! found at http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/4a827e8ced6efb0f/884b9eca6d7e6742
   9
  10 module mymod
  11
  12     type :: mytype
  13         integer :: i
  14         procedure(set_int_value), pointer :: seti
  15     end type
  16
  17     abstract interface
  18         subroutine set_int_value(this,i)
  19             import
  20             class(mytype), intent(inout) :: this
  21             integer, intent(in) :: i
  22         end subroutine set_int_value
  23     end interface
  24
  25     contains
  26
  27     subroutine seti_proc(this,i)
  28         class(mytype), intent(inout) :: this
  29         integer, intent(in) :: i
  30         this%i=i
  31     end subroutine seti_proc
  32
  33 end module mymod
  34
  35 program Test_03
  36     use mymod
  37     implicit none
  38
  39     type(mytype) :: m
  40
  41     m%i = 44
  42     m%seti => seti_proc
  43
  44     call m%seti(6)
  45
  46     if (m%i/=6) call abort()
  47
  48 end program Test_03
  49
  50 ! { dg-final { cleanup-modules "mymod" } }
  51