------- Comment #12 from janus at gcc dot gnu dot org 2008-11-01 14:06 -------
To clarify the situation regarding the code on c.l.f.: The link in comment #0
points to a thread which contains two example programs. One is called "fptr"
and uses Cray pointers, the other one is called "gptr" and uses procedure
pointers. Both contain minor formal errors.
The "gptr" example can not be compiled with gfortran at this point, since it
uses procedure pointers as function results, which are not yet supported (see
PR36704).
The corrected version of the "fptr" example looks like this:
module funcs
implicit none
! Interface block for function program fptr will invoke
! to get the C_FUNPTR
interface
function get_proc(mess) bind(C,name='BlAh')
use ISO_C_BINDING
implicit none
character(kind=C_CHAR) mess(*)
type(C_FUNPTR) get_proc
end function get_proc
end interface
end module funcs
module other_fun
use ISO_C_BINDING
implicit none
private
! Message to be returned by procedure pointed to
! by the C_FUNPTR
character, allocatable, save :: my_message(:)
! Interface block for the procedure pointed to
! by the C_FUNPTR
public abstract_fun
abstract interface
function abstract_fun(x)
use ISO_C_BINDING
import my_message
implicit none
integer(C_INT) x(:)
character(size(my_message),C_CHAR) abstract_fun(size(x))
end function abstract_fun
end interface
contains
! Procedure to store the message and get the C_FUNPTR
function gp(message) bind(C,name='BlAh')
character(kind=C_CHAR) message(*)
type(C_FUNPTR) gp
integer(C_INT64_T) i
i = 1
do while(message(i) /= C_NULL_CHAR)
i = i+1
end do
my_message = message(int(1,kind(i)):i-1)
gp = get_funloc(make_mess,aux)
end function gp
! Intermediate procedure to pass the function and get
! back the C_FUNPTR
function get_funloc(x,y)
procedure(abstract_fun) :: x
type(C_FUNPTR) y
external y
type(C_FUNPTR) get_funloc
get_funloc = y(x)
end function get_funloc
! Procedure to convert the function to C_FUNPTR
function aux(x)
interface
subroutine x() bind(C)
end subroutine x
end interface
type(C_FUNPTR) aux
aux = C_FUNLOC(x)
end function aux
! Procedure pointed to by the C_FUNPTR
function make_mess(x)
integer(C_INT) x(:)
character(size(my_message),C_CHAR) make_mess(size(x))
make_mess = transfer(my_message,make_mess(1))
end function make_mess
end module other_fun
program fptr
use funcs
use other_fun
use ISO_C_BINDING
implicit none
procedure(abstract_fun) :: fun
pointer(p,fun)
type(C_FUNPTR) fp
fp = get_proc('Hello, world'//achar(0))
p = transfer(fp,p)
write(*,'(a)') fun([1,2,3])
end program fptr
Compiling this via "gfortran-4.4 -fcray-pointer fptr.f90" yields the error:
end program fptr
1
Internal Error at (1):
gfc_get_default_type(): Bad symbol '@3'
With 4.3 I get an ICE on this, so it is no regression, though I haven't tried
4.2 or earlier.
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=36463
