Hi, I have a question here. Much appreciated if you could help!
So, here is my code:
$ cat extensible.f90
module util
implicit none
type :: base_t
real :: x
end type base_t
type, extends(base_t) :: ext_t
real :: y
real, allocatable :: data(:) [:]
end type ext_t
end module util
and if I compile it with caf -c extensible.f90 I get the following error:
$ caf -c extensible.f90
extensible.f90:8:34:
8 | type, extends(base_t) :: ext_t
| 1
Error: As extending type 'ext_t' at (1) has a coarray component, parent type 'base_t' shall also have one
My question is, why is the coarray component also required in the parent type?
The programmer is not required to allocate the coarray component in the base type, thus the only explanation I could find for myself is that the base type requires it’s own coarray component only for proper initialization and to be prepared for a coarray component extension then (the brains behind such design decisions are certainly experts): A derived type object containing a coarray component is obviously a distributed object. (In a more advanced setup, this can also be the case for derived type objects that do not contain coarray components). The (serial) counterpart is a purely local derived type object (not containing coarray components); Distributed objects allow remote communication, purely local objects do not.
A similar explanation can be found in Modern Fortran explained, section 17.8, last sentence, as well in the above compile time error message. I thought the question here was why the Fortran language was designed that way.
For a variable declared as class(thing), allocatable :: my_variable, the compiler needs to know if there is a possibility that allocating that variable will require synchronization. Allocating a coarray requires synchronization. Thus for any type that doesn’t have a coarray, the compiler needs to be able assume that any types extended from it don’t have a coarray, otherwise it would have to assume the opposite, and the use of any polymorphism (class(thing) variables) would require synchronization, even if there aren’t actually coarrays used.
I haven’t read the standard close enough to answer this, so does anyone know, is it required that class(*) variables not have coarray components, are compilers required to synchronize on allocation of class(*), or is this a potential loophole?
is it required that class(*) variables not have coarray components, are compilers required to synchronize on allocation of class(*) ,…
I can only confirm that declaring and allocating with class( * ) together with coarray components (using OpenCoarrays/gfortran) does work. Such codes appear not to conflict with the Fortran language (refering to MFe, section 17.8): class( * ) is declared only alongside with a coarray component thus, allocation of a class( * ) variable apparently does not involve synchronization, I’d say.
But using unlimited polymorphism to define and implement parallelism with distributed objects is really advanced stuff and may require to adapt a distributed objects model for that purpose.
On the other hand, declaring a derived type that contains a coarray component as
class(thing), allocatable :: my_variable
does also work (using OpenCoarrays). But this appears to conflict with the rule that such a variable must be non-allocatable. That’s why I am personally shy of using this.
I can only confirm that declaring and allocating with class( * ) together with coarray components (using OpenCoarrays/gfortran) does work. Such codes appear not to conflict with the Fortran language (refering to MFe, section 17.8): class( * ) is declared only alongside with a coarray component thus, allocation of a class( * ) variable apparently does not involve synchronization, I’d say.
Somebody just pointed me to a rule of the Fortran 2018 standard: “C937 (R927) type-spec shall not specify a type that has a coarray ultimate component.” I can’t tell if this rule does apply to the following test case. Ifort as well as OpenCoarrays/gfortran can handle such codes. Admitedly, I did only check for this and don’t use such coding myself yet.
program main
end program main
module a
implicit none
private
type, abstract, public :: base_type
private
integer, public, codimension[:], dimension (:), allocatable :: m_base_cc
contains
end type base_type
end module a
module b
use a
implicit none
private
type, extends(base_type), abstract, public :: my_type
private
class (*), allocatable, public :: object
integer, public, codimension[:], dimension (:), allocatable :: m_my_cc
contains
private
procedure, public :: s => sb
end type my_type
contains
subroutine sb (FO, object)
class (my_type), intent (inout) :: FO
class (*), intent(out), allocatable :: object
allocate (object, source = FO%object)
end subroutine sb
end module b
C937 (R927) type-spec shall not specify a type that has a coarray ultimate component
This C937(R927) is the same as Modern Fortran explained, section 17.8: “A variable … of a type that has an ultimate coarray component … must be a … non-allocatable scalar.”
(My simple test case did not even declare such a variable, but if it did it would be non-allocatable).
Another complaint was with the sourced allocation:
C949 (R930) The declared type of source-expr shall not have a coarray ultimate component
The source-expr in my test case was FO%object which is declared as class( * ) and does not have a coarray ultimate component in it. If rule C949 does apply to the encompassing derived type, then my test case could be non-conforming.
The compilers don’t complain and when I use this coding technique in a full running program everything works fine.