简体   繁体   中英

Specify polymorphic component in Fortran extended type

I'm writing a module that defines two derived types each having a derived type component with a common parent type, as follows.

   type :: aux0
      integer :: a
   end type aux0

   type, extends(aux0) :: aux1
      integer :: b
   end type aux1

   type, extends(aux0) :: aux2
      integer :: c
   end type aux2

I want to define two derived types each having a component of type aux1 and aux2 respectively. I have several routines that perform some work solely based on the field aux % a (eg fun1 ). I would like to bind these methods to both cplx1 , cplx2 . I thus created a common parent for cplx1 , cplx2 with a field aux of class aux0 and wrote an interface of class aux0 variables for the common functions. However, I would like to specify the type of the aux component in the actual types cplx1 , cplx2 because a few other functions require a definite type for the field aux . I am wondering how or whether this is doable.

module type

   ! ... aux# types definitions

   type :: cplx0
      class(aux0), allocatable :: aux(:)
   contains
      ! routines that use aux % a
      procedure, pass :: fun1
   end type cplx0

   type, extends(cplx0) :: cplx1
      ! type(aux1) :: aux(:) ! doesn't work
   contains
      ! routines that use aux % b
   end type cplx1

   type, extends(cplx0) :: cplx2
      ! type(aux2) :: aux(:)! doesn't work
   contains
      ! routines that use aux % c
   end type cplx2

contains 

   function fun1(self)
      class(cplx0) :: self
      integer      :: i
      do i = 1, size(self % aux)
         print *, self % aux(i) % a
      end do 
   end function fun1

  ! ... more functions

end module type

If I uncomment type(aux1) , the error is

Error: Component ‘aux’ at (1) already in the parent type at (2)

which is understandable, but I wonder how to circumvent it.

It is not possible. If you want to apply constraints through the type of a component, based on the type holding the component in some sort of extension hierarchy, then the component needs to be defined in the extensions.

Given the example code in the post, there's no requirement for the logic within fun1 to be bound to the cplx type hierarchy (it doesn't look like a procedure that extensions within the cplx hierarchy will override). The logic in fun1 could be in a non-type bound procedure, taking a polymorphic object of type aux, that implementations of a deferred binding of cplx forward to.

Alternatively/more generally, rather than fun1 operating directly on an aux component, have it operate on the equivalent of that component via a binding. For example:

module aux_module
  implicit none

  type :: aux0
    integer :: a
  end type aux0

  type, extends(aux0) :: aux1
    integer :: b
  end type aux1

  type, extends(aux0) :: aux2
    integer :: c
  end type aux2
contains
  ! Really the logic in `fun1` from the question's example code
  ! doesn't have to be within a binding.  It could be factored out.
  subroutine proc2(aux)
    class(aux0), intent(in) :: aux(:)
    integer :: i
    do i = 1, size(aux)
      print *, aux(i) % a
    end do 
  end subroutine proc2
end module aux_module

module cplx_module
  use aux_module
  implicit none

  type, abstract :: cplx0
  contains
    ! Does this have to be a binding?
    procedure :: proc1
    procedure(cplx0_get_aux), deferred :: get_aux
  end type cplx0

  interface
    function cplx0_get_aux(c)
      import cplx0
      import aux0
      implicit none
      class(cplx0), intent(in), target :: c
      ! we return a pointer in case we want it to be on the 
      ! left hand side of an assignment statement.
      class(aux0), pointer :: cplx0_get_aux(:)
    end function cplx0_get_aux
  end interface

  type, extends(cplx0) :: cplx1
    type(aux1) :: aux(2)
  contains
    procedure :: get_aux => cplx1_get_aux
  end type cplx1

  type, extends(cplx0) :: cplx2
    type(aux2) :: this_doesnt_have_to_be_called_aux(3)
  contains
    procedure :: get_aux => cplx2_get_aux
  end type cplx2
contains
  ! The internals of this could just forward to proc2.
  subroutine proc1(self)
    class(cplx0), target :: self
    integer      :: i
    associate(the_aux => self%get_aux())
      do i = 1, size(the_aux)
        print *, the_aux(i) % a
      end do 
    end associate
  end subroutine proc1

  function cplx1_get_aux(c)
    class(cplx1), intent(in), target :: c
    class(aux0), pointer :: cplx1_get_aux(:)
    cplx1_get_aux => c%aux
  end function cplx1_get_aux

  function cplx2_get_aux(c)
    class(cplx2), intent(in), target :: c
    class(aux0), pointer :: cplx2_get_aux(:)
    cplx2_get_aux => c%this_doesnt_have_to_be_called_aux
  end function cplx2_get_aux
end module cplx_module

program p
  use cplx_module
  implicit none

  type(cplx1) :: c1
  type(cplx2) :: c2

  c1 = cplx1([aux1(a=1,b=2), aux1(a=11,b=22)])
  call c1%proc1
  ! call proc2(c1%aux)

  c2 = cplx2([aux2(a=1,c=2), aux2(a=11,c=22), aux2(a=111,c=222)])
  call c2%proc1
  ! call proc2(c2%this_doesnt_have_to_be_called_aux)
end program p

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM