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