46 lines
893 B
Fortran
46 lines
893 B
Fortran
|
! { 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" } }
|