gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_2.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 39630: [F03] Procedure Pointer Components with PASS
   4 !
   5 ! taken from "The Fortran 2003 Handbook" (Adams et al., 2009)
   6
   7 module passed_object_example
   8
   9   type t
  10     real :: a
  11     procedure(print_me), pointer, pass(arg) :: proc
  12   end type t
  13
  14 contains
  15
  16   subroutine print_me (arg, lun)
  17     class(t), intent(in) :: arg
  18     integer, intent(in) :: lun
  19     if (abs(arg%a-2.718)>1E-6) call abort()
  20     write (lun,*) arg%a
  21   end subroutine print_me
  22
  23   subroutine print_my_square (arg, lun)
  24     class(t), intent(in) :: arg
  25     integer, intent(in) :: lun
  26     if (abs(arg%a-2.718)>1E-6) call abort()
  27     write (lun,*) arg%a**2
  28   end subroutine print_my_square
  29
  30 end module passed_object_example
  31
  32
  33 program main
  34   use passed_object_example
  35   use iso_fortran_env, only: output_unit
  36
  37   type(t) :: x
  38
  39   x%a = 2.718
  40   x%proc => print_me
  41   call x%proc (output_unit)
  42   x%proc => print_my_square
  43   call x%proc (output_unit)
  44
  45 end program main
  46
  47 ! { dg-final { cleanup-modules "passed_object_example" } }
  48