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" } }
|