When allocating a list of a parametrized derived type, it seems that gfortran only applies the correct parameter value to the first element in the array. Ifort and IFX handle the allocation as I would expect and apply the correct parameter value to all elements of the array.
Here is a minimal example to reproduce the issue:
program test
implicit none
type t(l)
integer, len:: l
integer, dimension(l):: a
end type
type(t(:)), dimension(:), allocatable:: arr
allocate(t(5):: arr(5))
call foo(arr)
contains
subroutine foo(bar)
type(t(*)), allocatable, dimension(:):: bar
print *, bar(1)%l
print *, bar(5)%l
end subroutine
end program
This program will print 5 and 0 when compiled with gfortran, but 5 and 5 (which I would expect) when compiled with ifort or ifx.
I am using gfortran 14.1.1. Is this indeed a bug or am I not seeing something?
Bug reporting
You can report bugs in the GCC Bugzilla system: first, update your major GFortran version to its latest release, then search if the bug was already reported, then file the bug. You can also use the GFortran mailing list fortran@gcc.gnu.org if you are uncertain on how to handle Bugzilla.
Unfortunately, in my experience almost all current Fortran compilers have problems with PDTs not just gfortran. What could be a truly useful addition to the language suffers from IMHO a poor design and even poorer implementations. PDTs could do a lot of what templates do but like FORALL and other features will never rise to their potential.
I have avoided using PDTs in my codes for the same portability reasons. I have never really even gotten to the point of comparing performance of codes with and without PDTs, if they don’t work at all with some of the popular compilers, then they just aren’t going to be used. However, I don’t know of anything wrong with the design. To me, the design looks good.
The issues faced by compiler implementations appear to be related to
LEN type parameters and
type extension i.e., the so-called object-oriented (OO) “class” inheritance.
In both these cases, the language design itself appears sound but the compiler implementations appear to struggle to understand the design and its scope and proceed with certain assumptions that lead to “compiler errors” which are effectively bugs in the compilers.
(gfortran especially faces the issue, but note the implementation in it was a highly part-time effort by one great GNU FOSS volunteer, Paul Richard Thomas, who really could have done with some help from other FOSS volunteers. I am disheartened few of the gfortran users (I am not a user, btw) have stepped up to become FOSS volunteers in the last 6-7 years, especially since this Discourse site has rekindled Community interest in Fortran. Through Sourcery Institute (nonprofit led by @rouson et al) I had funded out of pocket some of Paul Richard Thomas’ time. Unfortunately it couldn’t be carried forward at the time. But this can be resumed in one some form now, perhaps @rouson and @JerryD can show the way?)
The one issue I have with Fortran language design is with KIND parameters. The language, IMO never-humble, could have allowed this parameter to be restricted to a set declared by the type author, this would have helped both Fortran library developers (e.g., Fortran stdlib contributors) and consumers of such libraries such as the users of Fortran stdlib like the readers here. For example, in pseudo code
..
type:: t(k)
..
integer, kind :: k => <..> ! The rhs here could imply the set of values for
! the kind parameter k e.g.,
! real_kinds array from ISO_Fortran_Env intrinsic module
..
I agree that the LEN parameter is the biggest issue with PDTs. I also agree that another big issues is more a KIND parameter issue. As I’ve stated in the past, KIND would have been a lot more useful if past standards committees had mandated that REAL and INTEGER values must have distinct values so that you could differentiate between an INTEGER and a REAL just by its KIND value. Since most compilers have the same values (4 and 8) for REAL32/INT32 and REAL64/INT64 you can’t do something like TYPE(REAL32) to get a REAL32 value. Instead you have to do TYPE(REAL(REAL32)). Imagine a PDT where you could just do.
Type generic_container_t(kind)
Integer, kind :: kind
Type(kind) :: a
End Type
Type(generic_container_t(REAL32)) :: R4
Type(genreic_container_t(INT32)) :: I4
As far as I know only NAG does not use the same value for REAL and INTEGER KINDS. I guess the reason for 4 and 8 was to appease the folks who insist on still doing REAL*4 or INTEGER*8