Quote:may.ka wrote:

may_ka · ‎01-11-2017

Hi there

I am trying to have a type bound function pointer inherited downhill through the class hierachy.

an example would be:

Module Mod_Bla_1
  Type :: Bla_1
    Procedure(SubGlobal_1), Pointer :: fun=>null()
  contains
    Procedure, Pass, Public :: Init => SubInit
  End type Bla_1
  Abstract Interface
    Subroutine SubGlobal_1(this)
      Import Bla_1
      Class(Bla_1), Intent(InOut) :: this
    End Subroutine SubGlobal_1
  End Interface
  Private :: SubBla1, SubInit
contains
  Subroutine SubInit(this)
    Class(Bla_1), Intent(InOut) :: this
    this%fun=>SubBla1
  end Subroutine SubInit
  Subroutine SubBla1(this)
    Class(Bla_1), Intent(InOut) :: this
  End Subroutine SubBla1
End Module Mod_Bla_1
Module Mod_Bla_2
  use Mod_Bla_1
  Type, extends(Bla_1) :: Bla_2
  contains
    Procedure, Pass, Public :: Init => SubInit
  End type Bla_2
  Private :: SubBla2, SubInit
contains
  Subroutine SubInit(this)
    Class(Bla_2), Intent(InOut) :: this
    this%fun=>SubBla2
  end Subroutine SubInit
  Subroutine SubBla2(this)
    Class(Bla_2), Intent(InOut) :: this
  End Subroutine SubBla2
End Module Mod_Bla_2
Program Test
  use Mod_Bla_1
  use Mod_Bla_2
  Type(Bla_1) :: xb1
  Type(Bla_2) :: xb2
  call xb1%init()
  call xb2%init()
End Program Test

However this does not compile with error message:

The procedure pointer and the procedure target must have matching arguments.
this%fun=>SubBla2

That would require me to write a new pointer for every child class, which would require me to "invent" a naming hierachy in order get it compiled (e.g. "fun_class_bla_1", "fun_class_bla_2") etc.

Is there any chance to get the example working.

Thanks a lot

Cheers

FortranFan · ‎01-11-2017

may.ka wrote:

.. Is there any chance to get the example working...

To get the example compile and run with the least code change, you can modify the dummy argument of SubBla2 to be 'class(Bla_1'. But then in order for SubBla2 to be useful, more work might be necessary in the form of "SELECT TYPE" construct. You don't show what you are actually trying to achieve with the PROCEDURE POINTER component, there may be other design patterns that may work out better.

may_ka · ‎01-11-2017

Hi,

what I am trying to achieve is that I have two type bound procedures (e.g. sub1 and sub2) bound to bla_1 which are used conditional on how bla_1 is initialized. Both routines are overwritten in bla_2. In order to avoid if-branches checking conditions about whether to call sub1 or sub2 (called from bla_1 or bla_2), I thought about using a procedure pointer which can be set appropriately when bla_1(or bla_2) is initialized (in a practical application it is not just sub 1 and 2, it is sub 1 to 8).

Thanks

FortranFan · ‎01-11-2017

may.ka wrote:

.. what I am trying to achieve is that I have two type bound procedures (e.g. sub1 and sub2) bound to bla_1 which are used conditional on how bla_1 is initialized. Both routines are overwritten in bla_2. In order to avoid if-branches checking conditions about whether to call sub1 or sub2 (called from bla_1 or bla_2), I thought about using a procedure pointer which can be set appropriately when bla_1(or bla_2) is initialized (in a practical application it is not just sub 1 and 2, it is sub 1 to 8). ..

Some object-oriented design may be due for your application, if you haven't done so already.

Based on what you describe, one possibility is an ABSTRACT base class that has a public procedure pointer component, a DEFERRED Init procedure, DEFERRED TBPs of sub1 thru' N, concrete TBPs that mirror to each of these deferred procedures (e.g., base_sub1 for sub1, etc.), and a setter procedure for the procedure pointer component that points to one of these mirrors. These mirror TBPs then simply invoke the corresponding deferred procedures e.g., base_sub1 will invoke sub1 and so forth.

The concrete extensions such as bla_1 and bla_2 then provide concrete implementations of DEFERRED TBPs (sub1 => sub1_bla_1, sub2 => sub2_bla_1, sub1 => sub1_bla_2, etc.) as well as the Init procedure; Init then sets up the procedure pointer by invoking the setter method of the ABSTRACT base type using whatever logic is relevant for that type.

It's up to you to decide if this is worth your effort.

may_ka · ‎01-12-2017

Hi FortranFan

I cannot get it to work (see code below). Why would I need a setter method instead of setting the pointer in init?? I am still getting the same compilaiton error: "The procedure pointer and the procedure target must have matching arguments.".

Thanks for any comments.

Cheers

Module Mod_Bla_0
  Type, Abstract :: Bla_0
    Procedure(SubIF), Public, Pointer :: fun=>null()
  contains
    Procedure(SubIF), Deferred, Pass, Public :: Bla1
    Procedure(SubIF), Deferred, Pass, Public :: Bla2
  End type Bla_0
  Abstract Interface
    Subroutine SubIF(this)
      Import Bla_0
      Class(Bla_0), Intent(Inout) :: this
    End Subroutine SubIF
  End Interface
End Module Mod_Bla_0
Module Mod_Bla_1
  use Mod_Bla_0
  Type, extends(Bla_0) :: Bla_1
  contains
    Procedure, Pass, Public :: Init => SubInit
    Procedure, Pass :: Bla1 => SubBla1
    Procedure, Pass :: Bla2 => SubBla2
  End type Bla_1
  Private :: SubBla1, SubBla2, SubInit
contains
  Subroutine SubInit(this)
    Class(Bla_1), Intent(InOut) :: this
    this%fun=>SubBla1
  end Subroutine SubInit
  Subroutine SubBla1(this)
    Class(Bla_1), Intent(InOut) :: this
  End Subroutine SubBla1
  Subroutine SubBla2(this)
    Class(Bla_1), Intent(InOut) :: this
  End Subroutine SubBla2
End Module Mod_Bla_1
Module Mod_Bla_2
  use Mod_Bla_1
  Type, extends(Bla_1) :: Bla_2
  contains
    Procedure, Pass, Public :: Init => SubInit
    Procedure, Pass :: Bla1 => SubBla1
    Procedure, Pass :: Bla2 => SubBla2
  End type Bla_2
  Private :: SubBla1, SubBla2, SubInit
contains
  Subroutine SubInit(this)
    Class(Bla_2), Intent(InOut) :: this
    !!this%fun=>this%SubBla1
  end Subroutine SubInit
  Subroutine SubBla1(this)
    Class(Bla_2), Intent(InOut) :: this
  End Subroutine SubBla1
  Subroutine SubBla2(this)
    Class(Bla_2), Intent(InOut) :: this
  End Subroutine SubBla2
End Module Mod_Bla_2
Program Test
  use Mod_Bla_1
  use Mod_Bla_2
  Type(Bla_1) :: xb1
  Type(Bla_2) :: xb2
  call xb1%init()
  call xb2%init()
End Program Test

FortranFan · ‎01-12-2017

may.ka wrote:

.. I cannot get it to work (see code below). Why would I need a setter method instead of setting the pointer in init?? ..

See below. Notice my earlier comment about mirror TBPs in the abstract type. As to the "setter" method, the rationale for my suggestion is the OO concept of encapsulation. It's bad enough that Fortran only offers PRIVATE/PUBLIC attributes for MODULE entities and it misses on what I think is an essential third category of "INTERNAL" for extension types; this forces one to make public things that are better kept private to the type and its children; if I had a need to do something like what you are trying, I would prefer not to expose the "wiring" for procedure pointer FUN and thus keep the mirror TBPs private. Hence the setter method.

You need to decide whether something like this is worth the effort in your actual application; OO is neat but as you know it can require more infrastructure type of code and there can be added complexity associated with it, as seen here.

(By the way, the code below follows some stylistic patterns that I like but which differ from yours)

module Mod_Bla_0

   implicit none

   private

   type, abstract, public :: Bla_0
      private
      procedure(Ifun), public, pointer :: fun => null()
   contains
      private
      procedure, pass(this) :: Base_Bla1  ! "private" mirror procedures to serve as
      procedure, pass(this) :: Base_Bla2  ! pointers to the actual ones
      procedure(Ifun), deferred, pass(this), public :: Bla1
      procedure(Ifun), deferred, pass(this), public :: Bla2
      procedure(IInit), deferred, pass(this), public :: Init ! this will force extension types to implement Init
      procedure, pass(this), public :: SetFun  ! "setter" method for OO encapsulation concept
   end type Bla_0

   abstract interface
   
      subroutine Ifun(this)
      
         import :: Bla_0
         
         class(Bla_0), intent(inout) :: this
         
      end subroutine Ifun
      
      subroutine IInit(this) ! separate interface because this might have different
                             ! arguments than Ifun
      
         import :: Bla_0
         
         class(Bla_0), intent(inout) :: this
         
      end subroutine IInit
      
   end interface

contains

   subroutine Base_Bla1(this)

      class(Bla_0), intent(inout) :: this

      ! invocation of the actual implementation of Bla1
      call this%Bla1()

      return

   end subroutine Base_Bla1

   subroutine Base_Bla2(this)

      class(Bla_0), intent(inout) :: this

      ! invocation of the actual implementation of Bla2
      call this%Bla2()

      return

   end subroutine Base_Bla2

   subroutine SetFun(this, key)

      class(Bla_0), intent(inout) :: this
      integer, intent(in)         :: key   ! some data to set 'fun' procedure pointer
                                           ! shown here as an integer key
      select case ( key )
         case ( 1 )
            this%fun => Base_Bla1
         case ( 2 )
            this%fun => Base_Bla2
         case default
            ! error handling elided
      end select

      return

   end subroutine SetFun

end module Mod_Bla_0

module Mod_Bla_1

   use Mod_Bla_0, only : Bla_0

   implicit none

   private

   type, extends(Bla_0), public :: Bla_1
      private
      character(len=16) :: m_s = "Bla_1 says Hello"
   contains
      private
      procedure, pass(this), public :: Init => SubInit
      procedure, pass(this), public :: Bla1 => SubBla1
      procedure, pass(this), public :: Bla2 => SubBla2
   end type Bla_1

contains

   subroutine SubInit(this)

      class(Bla_1), intent(inout) :: this

      ! logic to set "fun" goes here
      call this%SetFun( 1 )

      return
   end subroutine SubInit

   subroutine SubBla1(this)

      class(Bla_1), intent(inout) :: this

      print *, "SubBla1: ", this%m_s

      return

   end subroutine SubBla1

   subroutine SubBla2(this)

      class(Bla_1), intent(inout) :: this

      print *, "SubBla2: ", this%m_s

      return

   end subroutine SubBla2

end module Mod_Bla_1

module Mod_Bla_2

   use Mod_Bla_0, only : Bla_0

   implicit none

   private

   type, extends(Bla_0), public :: Bla_2
      private
      character(len=16) :: m_s = "Bla_2 says Hello"
   contains
      private
      procedure, pass(this), public :: Init => SubInit
      procedure, pass(this), public :: Bla1 => SubBla1
      procedure, pass(this), public :: Bla2 => SubBla2
   end type Bla_2

contains

   subroutine SubInit(this)

      class(Bla_2), intent(inout) :: this

      ! logic to set "fun" goes here
      call this%SetFun( 2 )

      return

   end subroutine SubInit

   subroutine SubBla1(this)

      class(Bla_2), intent(inout) :: this

      print *, "SubBla1: ", this%m_s

      return

   end subroutine SubBla1

   subroutine SubBla2(this)

      class(Bla_2), intent(inout) :: this

      print *, "SubBla2: ", this%m_s

      return

   end subroutine SubBla2

end module Mod_Bla_2

program Test

   use Mod_Bla_1, only : Bla_1
   use Mod_Bla_2, only : Bla_2

   implicit none

   type(Bla_1) :: xb1
   type(Bla_2) :: xb2

   call xb1%init()
   call xb1%fun()

   call xb2%init()
   call xb2%fun()

   stop

end program Test

Upon execution of code compiled with Intel Fortran compiler 17, update 1:

 SubBla1: Bla_1 says Hello
 SubBla2: Bla_2 says Hello

class bound function pointer inheritance