Trying to pass different procedure pointers

  • Follow


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


0
Reply not_valid (1681) 1/26/2011 12:22:16 AM


0 Replies
147 Views

(page loaded in 0.042 seconds)

Similiar Articles:













7/15/2012 12:50:38 AM


Reply: