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
9module 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
27contains
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
43end module proc_component_example
44
45program 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
61end program main
62