summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/proc_ptr_6.f90
blob: 6a5c7e5f462505f444d48e930037945d0956f524 (plain)
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
! { dg-do run }
!
! PROCEDURE POINTERS as actual/formal arguments
!
! Contributed by Janus Weil <janus@gcc.gnu.org>

subroutine foo(j)
  INTEGER, INTENT(OUT) :: j
  j = 6
end subroutine

program proc_ptr_6

PROCEDURE(),POINTER :: ptr1
PROCEDURE(REAL),POINTER :: ptr2
EXTERNAL foo
INTEGER :: k = 0

ptr1 => foo
call s_in(ptr1,k)
if (k /= 6) call abort()

call s_out(ptr2)
if (ptr2(-3.0) /= 3.0) call abort()

contains

subroutine s_in(p,i)
  PROCEDURE(),POINTER,INTENT(IN) :: p
  INTEGER, INTENT(OUT) :: i
  call p(i)
end subroutine

subroutine s_out(p)
  PROCEDURE(REAL),POINTER,INTENT(OUT) :: p
  p => abs
end subroutine

end program