gcc/testsuite/gfortran.dg/proc_ptr_comp_6.f90

   1 ! { dg-do run }
   2 !
   3 ! PR39630: Fortran 2003: Procedure pointer components.
   4 !
   5 ! test case taken from:
   6 ! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/4a827e8ced6efb0f/884b9eca6d7e6742?#884b9eca6d7e6742
   7 ! http://fortranwiki.org/fortran/show/proc_component_example
   8
   9 module proc_component_example
  10
  11   type t
  12     real :: a
  13     procedure(print_int), pointer, &
  14                           nopass :: proc
  15   end type t
  16
  17   abstract interface
  18     subroutine print_int (arg, lun)
  19       import
  20       type(t), intent(in) :: arg
  21       integer, intent(in) :: lun
  22     end subroutine print_int
  23   end interface
  24
  25   integer :: calls = 0
  26
  27 contains
  28
  29   subroutine print_me (arg, lun)
  30     type(t), intent(in) :: arg
  31     integer, intent(in) :: lun
  32     write (lun,*) arg%a
  33     calls = calls + 1
  34   end subroutine print_me
  35
  36   subroutine print_my_square (arg, lun)
  37     type(t), intent(in) :: arg
  38     integer, intent(in) :: lun
  39     write (lun,*) arg%a**2
  40     calls = calls + 1
  41   end subroutine print_my_square
  42
  43 end module proc_component_example
  44
  45 program main
  46
  47     use proc_component_example
  48     use iso_fortran_env, only : output_unit
  49
  50     type(t) :: x
  51
  52     x%a = 2.71828
  53
  54     x%proc => print_me
  55     call x%proc(x, output_unit)
  56     x%proc => print_my_square
  57     call x%proc(x, output_unit)
  58
  59     if (calls/=2) STOP 1
  60
  61 end program main