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 (e.g. 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