blob: f45d114f833698aa63a50fe2209e0577a043c753 (
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
40
41
42
43
44
45
|
! { dg-do run }
! { dg-additional-sources proc_ptr_8.c }
!
! PR fortran/32580
! Original test case
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
MODULE X
USE ISO_C_BINDING
INTERFACE
INTEGER(KIND=C_INT) FUNCTION mytype( a ) BIND(C)
USE ISO_C_BINDING
INTEGER(KIND=C_INT), VALUE :: a
END FUNCTION
SUBROUTINE init() BIND(C,name="init")
END SUBROUTINE
END INTERFACE
TYPE(C_FUNPTR), BIND(C,name="funpointer") :: funpointer
END MODULE X
USE X
PROCEDURE(mytype), POINTER :: ptype,ptype2
CALL init()
CALL C_F_PROCPOINTER(funpointer,ptype)
if (ptype(3) /= 9) call abort()
! the stuff below was added with PR 42072
call setpointer(ptype2)
if (ptype2(4) /= 12) call abort()
contains
subroutine setpointer (p)
PROCEDURE(mytype), POINTER :: p
CALL C_F_PROCPOINTER(funpointer,p)
end subroutine
END
! { dg-final { cleanup-modules "X" } }
|
