with all types finalizable, and at least one allocatable or real(real128) component, type finalization is wrongly called going out of scope:
2 times instead of one
the second time, with a wrong base address (or at least, the object contains garbage).
This is a pretty big problem because any flags that store i.e. a C address will be non-NULL anymore, or a pointer may become associated, which triggers all sorts of issues and crashes.
So I believe I’ve stumbled upon a gfortran regression issue (all good with gfortran < 13), but I’d like to share this information to know whether anyone else has been affected.
In the attached program, there is an intent(out) argument so finalization should only be called once, as the subroutine enters:
enter in-n-out
r final ! ok: finalize parent type
q final F ! ok: finalize intermediate type
p final -1. ! ok: finalize 3rd-level scalars
p final -1
p final 0 ! WRONG: 2nd-time and wrong value
do something ! WRONG: should not be called!
p final 0 ! WRONG: 2nd-time and wrong value
do something ! WRONG: should not be called!
hello world
exit in-n-out
Yes, I’ve noticed issues even without final subroutines, just allocatable components seem to hit some issues. I haven’t worked out exactly how complicated or in what way is required to trigger it yet.
What is your sense re: the number of FOSS contributors to GCC/gfortran currently? Do you think enough contributors are actively working toward enhancing gfortran with current standard features and bug resolutions? It appeared not too long ago the GCC/gfortran effort in terms of active contributors, who really can make a positive difference to the toolset, was starting to drop off precipitously. Is that accurate?
Thus your feeling of regression starting with GCC 14 makes sense. Have you tried reaching out to @JerryD and inquire of options to investigate this further?
In the meantime, you may consider a code design as follows and check whether it helps with GCC >= v14. In this updated code structure, the design is that a FINAL procedure is bound to the type only where needed which, per the snippet you show, applies only to your type q
module m1
use iso_fortran_Env, only: real128
type :: p
integer :: addr = -1
end type p
type :: q
type(p), pointer :: f(:) => null()
type(p) :: b,c
type(p), allocatable :: e(:)
contains
final :: qf
end type q
type :: r
type(q) :: a
end type r
contains
impure elemental subroutine qf(this) !<-- note: impure ONLY for diagnostics purposes here
type(q), intent(inout) :: this
print *, ' - q final ',associated(this%f)
if (associated(this%f)) deallocate(this%f)
if (allocated(this%e)) deallocate(this%e) !<-- do explicit deallocation of ALLOCATABLEs if adding a FINAL method
end subroutine qf
end module m1
I 100% understand and am sympathetic. I have been myself - though being at full throttle already - trying to learn better the gfortran internals in the hope that I’ll be able to contribute directly at some point, but currently put that effort on hold due to too much work.
I believe a good MWE is a useful contribution anyways, as can be used by all compiler developers. It took me almost 1 full day of work to figure out the bug and reduce the far larger codebase down to this example (the crash had popped up when I added one real(real128) scalar to the innermost derived type).
For me it would be very valuable if some of the core developers of GFortran made a wiki post here in Fortran-lang with instructions on how people could:
locate the source of a bug
how to contribute and submit patches
run the test suite
Last time I had to do this I remember it being rather hard. I think some good contributing docs would lower the barrier to entry substantially.
Agree with your point but it is unlikely anyone of the few remaining (this is my assumption based on hearsay) “core developers” of GCC/gfortran will be willing to do this, unfortunately.
From a distance, it appears GCC/gfortran can do with a major generational “landgrab” whereby a new generation grabs the current instructions and updates them for easier understanding and creates a new set of “contributing docs” and perhaps these docs themselves are crowd-sourced someplace (some modern “pure” open source site?) for easier maintenance and updates into the future.
Ultimately the whole GCC/gfortran development workflow needs to move elsewhere, again to some modern and “pure” open source site …
Yes, I’ve seen finalization issues like that in the primary code I work with starting with gfortran 13 and all later. Like @everythingfunctional I haven’t yet been able to extract a reportable example. If you have such an example please file a report with the gcc bugzilla. For now we’re stuck on gfortran 12.3.