I've been having so much fun programming lately that I thought I
might share some of my joy with you. I wanted to pass procedure
pointer components to a subroutine which would associate them with
targets via C_F_FUNPOINTER. Here is my first attempt:
C:\gfortran\opengl\wglext>type bug1.f90
module m1
implicit none
abstract interface
function sub1(x) bind(C)
use ISO_C_BINDING
integer(C_INTPTR_T) sub1
integer(C_INT) x
end function sub1
end interface
type T
procedure(sub1),pointer,NOPASS :: sub1
end type T
end module m1
module m2
use m1
implicit none
contains
subroutine sub2(x)
type(T) x
call sub3(x%sub1)
end subroutine sub2
subroutine sub3(sub4)
use ISO_C_BINDING
implicit integer(C_INTPTR_T) (s)
procedure(),pointer :: sub4
end subroutine sub3
end module m2
C:\gfortran\opengl\wglext>gfortran -c bug1.f90
bug1.f90:22.19:
call sub3(x%sub1)
1
Error: Type mismatch in argument 'sub4' at (1); passed INTEGER(8) to UNKNOWN
It took me a while to figure out what the error message was
complaining about. Really it's not saying anything about the actual
and dummy arguments but the characteristics of the result variables
of their targets. So it's saying that actual argument x%sub1 points
at functions that return integer(C_INTPTR_T), whereas dummy argument
sub4 points at subroutines. Although I disagree with this because it
says in N1830.pdf, section 12.4.3.6:
"If proc-interface does not appear, the procedure declaration
statement does not specify whether the declared procedures or
procedure pointers are subroutines or functions."
So dummy argument sub4 seems to me to be ambiguous between whether
it points at functions returning integer(C_INTPTR_T) as implicitly
typed, or at subroutines. I couldn't find anything in section
12.5.2.9 that stood in the way of this attempt, either.
But I do want to pass procedure pointer components that point at
functions with different result characteristics so that means that
this first try isn't good enough even if the compiler was wrong to
refuse it.
My second try probably looks just pitiful to those of you who know
what they're doing, but here it goes:
C:\gfortran\opengl\wglext>type bug1a.f90
module m1
implicit none
abstract interface
function sub1(x) bind(C)
use ISO_C_BINDING
integer(C_INTPTR_T) sub1
integer(C_INT) x
end function sub1
end interface
type T
procedure(sub1),pointer,NOPASS :: sub1
end type T
end module m1
module m2
use m1
implicit none
contains
subroutine sub2(x)
type(T) x
call sub3(x%sub1)
end subroutine sub2
subroutine sub3(sub4)
external sub4
pointer sub4
class(*) sub4
end subroutine sub3
end module m2
C:\gfortran\opengl\wglext>gfortran -c bug1a.f90
bug1a.f90:28.16:
class(*) sub4
1
Error: Invalid character in name at (1)
bug1a.f90:22.19:
call sub3(x%sub1)
1
Error: Type mismatch in argument 'sub4' at (1); passed INTEGER(8) to UNKNOWN
I've never tried unlimited polymorphism before. Is this the
right syntax? Does gfortran support it yet? On to the third
attempt:
C:\gfortran\opengl\wglext>type bug2.f90
module m1
implicit none
abstract interface
function sub1(x) bind(C)
use ISO_C_BINDING
integer(C_INTPTR_T) sub1
integer(C_INT) x
end function sub1
end interface
abstract interface
subroutine sub6(x) bind(C)
use ISO_C_BINDING
integer(C_INT) x
end subroutine sub6
end interface
type T
procedure(sub1),pointer,NOPASS :: sub1
procedure(sub6),pointer,NOPASS :: sub6
end type T
end module m1
module m2
use m1
implicit none
interface sub
module procedure sub3, sub5
end interface sub
contains
subroutine sub2(x)
type(T) x
write(*,'(a)') 'Calling sub(x%sub1)'
call sub(x%sub1)
write(*,'(a)') 'Calling sub(x%sub6)'
call sub(x%sub6)
end subroutine sub2
subroutine sub3(sub4)
procedure(),pointer :: sub4
write(*,'(a)') 'In sub3'
end subroutine sub3
subroutine sub5(sub4)
procedure(integer(8)),pointer :: sub4
write(*,'(a)') 'In sub5'
end subroutine sub5
end module m2
program test
use m2
implicit none
type(T) x
call sub2(x)
end program test
C:\gfortran\opengl\wglext>gfortran -std=f2003 bug2.f90 -obug2
C:\gfortran\opengl\wglext>bug2
Calling sub(x%sub1)
In sub5
Calling sub(x%sub6)
In sub3
Success! Well, sort of. This time I think my code is not standard-
conforming because it's so hard to distinguish subroutine procedure
pointer dummy arguments from function procedure pointer dummy
arguments. So I finally arrived at:
C:\gfortran\opengl\wglext>type bug3.f90
module m1
implicit none
abstract interface
function sub1(x) bind(C)
use ISO_C_BINDING
implicit none
integer(C_INT) sub1
integer(C_INT),value :: x
end function sub1
end interface
abstract interface
subroutine sub6(x) bind(C)
use ISO_C_BINDING
implicit none
integer(C_INT),value :: x
end subroutine sub6
end interface
type T
procedure(sub1),pointer,NOPASS :: sub1
procedure(sub6),pointer,NOPASS :: sub6
end type T
end module m1
module m2
use m1
implicit none
interface sub
module procedure sub5
end interface sub
contains
subroutine sub2(x)
implicit integer(x)
procedure(),pointer :: x
write(*,'(a)') 'In sub2'
end subroutine sub2
subroutine sub5(sub4)
procedure(integer),pointer :: sub4
write(*,'(a)') 'In sub5'
end subroutine sub5
end module m2
program test
use m2
implicit none
type(T) tau
call sub(tau%sub1)
call sub2(tau%sub6)
end program test
C:\gfortran\opengl\wglext>gfortran -std=f2003 bug3.f90 -obug3
C:\gfortran\opengl\wglext>bug3
In sub5
In sub2
So this works, meaning I can have one generic name to pass all the
function pointers to and one specific name to pass the subroutines
to. I'm still a little uneasy because the actual arguments have
the BIND attribute while the dummy arguments don't, but I couldn't
find where it says that this is disallowed.
--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end
|