Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Workaround for multiple interfaces to function

34 views
Skip to first unread message

James Van Buskirk

unread,
Jan 1, 2011, 11:19:24 PM1/1/11
to
It does not seem uncommon for a C function to specify an interface
that has an input of TYPE(C_PTR),value. When that input is
C_NULL_PTR, the function is supposed to use some kind of default
and if not, it gets derefenced as CHARACTER(KIND=C_CHAR) and then
the sentinel character C_NULL_CHAR tells us where to stop
dereferencing.

There are two ways for a Fortran program to try to write the
interface for such a function:

1) As TYPE(C_PTR),value :: lpStr
But if you do that then when you actually want to pass a NUL-
terminated string you have to take the C_LOC of its first
character, which requires the string variable to have the TARGET
attribute and is especially nettlesome when you wanted to pass the
result of an expression.

2) As CHARACTER(KIND=C_CHAR) lpStr(*)
But is you do that you and then you want to pass C_NULL_PTR by value
you have to compose a Fortran pointer to a character variable and
then force it to point at C_NULL_PTR via C_F_POINTER. Quite dodgy
and it seems to me that the compiler could try to make a copy of your
'string' and pass the address of the copy.

I have heard that some compilers have an extension where you can
pass C_NULL_PTR in case 2 above but I don't like the extension for
2 reasons:

i) Sometimes you don't want to pass C_NULL_PTR, but an atom or a
resource identifier. See:

http://msdn.microsoft.com/en-us/library/ms648391(v=vs.85).aspx

ii) What happens when the dummy argument is

TYPE(C_PTR) lpVoid

Then if you pass it C_NULL_PTR, what level of indirection do you
get? Does it allocate some memory, copy the value of C_NULL_PTR
into it, then pass the address of that memory as the standard would
have the compiler do, or does it pass C_NULL_PTR by value as the
extension would say?

So the way I want to do it is to just write two interface bodies
for the function so I can invoke them both under the same generic
name.

C:\gfortran\clf\same_name>type same_namea.f90
module actual_fun
use ISO_C_BINDING
implicit none
private
contains
function fun(x) bind(C,name='fun')
use ISO_C_BINDING
implicit none
real(C_FLOAT) fun
real(C_FLOAT) x
fun = x**2
end function fun
end module actual_fun

module all_fun
use ISO_C_BINDING
implicit none
private
public fun
interface fun
function fun_real(x) bind(C,name='fun')
import
implicit none
real(C_FLOAT) fun_real
real(C_FLOAT) x
end function fun_real
end interface fun
interface fun
function fun_C_PTR(x) bind(C,name='fun')
import
implicit none
real(C_FLOAT) fun_C_PTR
type(C_PTR),value :: x
end function fun_C_PTR
end interface fun
end module all_fun

program test
use ISO_C_BINDING
use all_fun
implicit none
real(C_FLOAT), target :: x
type(C_PTR) ptr

x = 17
ptr = C_LOC(x)
write(*,'(a,f0.0)') 'fun(x) = ', fun(x)
write(*,'(a,f0.0)') 'fun(ptr) = ', fun(ptr)
end program test

C:\gfortran\clf\same_name>gfortran same_namea.f90 -osme_namea
same_namea.f90:29.6:

function fun_C_PTR(x) bind(C,name='fun')
1
same_namea.f90:6.6:

function fun(x) bind(C,name='fun')
2
Error: Binding label 'fun' in interface body at (1) collides with the global
ent
ity 'fun' at (2)
same_namea.f90:21.6:

function fun_real(x) bind(C,name='fun')
1
same_namea.f90:6.6:

function fun(x) bind(C,name='fun')
2
Error: Binding label 'fun' in interface body at (1) collides with the global
ent
ity 'fun' at (2)
same_namea.f90:40.14:

use all_fun
1
Fatal Error: Can't open module file 'all_fun.mod' for reading at (1): No
such fi
le or directory
gfortran: internal compiler error: Aborted (program f951)
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.

Now of course you have to allow binding names to collide with global
entities like C function names in this manner or references for
procedures with a binding name could never be satisfied. Even
though it's a compiler bug, we have to find some kind of workaround
if we are to move forward. The first attempt is to put the two
interface bodies in different interface blocks:

C:\gfortran\clf\same_name>type same_nameb.f90
module actual_fun
use ISO_C_BINDING
implicit none
private
contains
function fun(x) bind(C,name='fun')
use ISO_C_BINDING
implicit none
real(C_FLOAT) fun
real(C_FLOAT) x
fun = x**2
end function fun
end module actual_fun

module real_fun
use ISO_C_BINDING
implicit none
private
public generic_fun
interface generic_fun
function fun(x) bind(C,name='fun')
import
implicit none
real(C_FLOAT) fun
real(C_FLOAT) x
end function fun
end interface generic_fun
end module real_fun

module all_fun
use ISO_C_BINDING
use real_fun, only: fun => generic_fun
implicit none
private
public fun
interface fun
function fun(x) bind(C,name='fun')
import
implicit none
real(C_FLOAT) fun
type(C_PTR),value :: x
end function fun
end interface fun
end module all_fun

program test
use ISO_C_BINDING
use all_fun
implicit none
real(C_FLOAT), target :: x
type(C_PTR) ptr

x = 17
ptr = C_LOC(x)
write(*,'(a,f0.0)') 'fun(x) = ', fun(x)
write(*,'(a,f0.0)') 'fun(ptr) = ', fun(ptr)
end program test

C:\gfortran\clf\same_name>gfortran same_nameb.f90 -osme_nameb
same_nameb.f90:37.18:

function fun(x) bind(C,name='fun')
1
Error: Cannot change attributes of USE-associated symbol generic_fun at (1)
same_nameb.f90:38.15:

import
1
Error: IMPORT statement at (1) only permitted in an INTERFACE body

And the cascade has begun. Having a specific name the same as the
generic name which can resolve to it is a bit problematic but I
think it should be good Fortran. Cf. many intrinsic functions such
as SIN. So I think this is another bug. But to move forward now
we try:

C:\gfortran\clf\same_name>type same_namec.f90
module actual_fun
use ISO_C_BINDING
implicit none
private
contains
function fun(x) bind(C,name='fun')
use ISO_C_BINDING
implicit none
real(C_FLOAT) fun
real(C_FLOAT) x
fun = x**2
end function fun
end module actual_fun

module real_fun
use ISO_C_BINDING
implicit none
private
public generic_fun
interface generic_fun
function fun(x) bind(C,name='fun')
import
implicit none
real(C_FLOAT) fun
real(C_FLOAT) x
end function fun
end interface generic_fun
end module real_fun

module C_PTR_fun
use ISO_C_BINDING
implicit none
private
public fun
interface fun
function fun(x) bind(C,name='fun')
import
implicit none
real(C_FLOAT) fun
type(C_PTR),value :: x
end function fun
end interface fun
end module C_PTR_fun

module all_fun
use ISO_C_BINDING
use real_fun, only: fun => generic_fun
use C_PTR_fun
implicit none
private
public fun
end module all_fun

program test
use ISO_C_BINDING
use all_fun
implicit none
real(C_FLOAT), target :: x
type(C_PTR) ptr

x = 17
ptr = C_LOC(x)
write(*,'(a,f0.0)') 'fun(x) = ', fun(x)
write(*,'(a,f0.0)') 'fun(ptr) = ', fun(ptr)
end program test

C:\gfortran\clf\same_name>gfortran same_namec.f90 -osame_namec

C:\gfortran\clf\same_name>same_namec
fun(x) = 289.
fun(ptr) = 289.

Success at last! All that was necessary was to hide the generic
name and binding name from the compiler when defining a new interface
for the function and it all worked. The part of the compiler that
has the erroneous checks doesn't come into play at the point that all
the generic names and our specific name are combined into one name.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end


0 new messages