https://gcc.gnu.org/bugzilla/show_bug.cgi?id=125429
Bug ID: 125429
Summary: Finalization in an assignment may use temporary
variables out of scope
Product: gcc
Version: 17.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: mikael at gcc dot gnu.org
Target Milestone: ---
Taken from PR125391 comment#16.
The variable used in the finalization guarding condition at the beginning of
save_vals has its declaration in the scalarization loop body. Oops.
$ gfortran -c z.f90 -fdump-tree-original
z.f90:26:49:
26 | o(pick_first(o%available, size(o)))%items = i
| ^
internal compiler error: in gimplify_var_or_parm_decl, at gimplify.cc:3346
0x7efcea171f76 __libc_start_call_main
../sysdeps/nptl/libc_start_call_main.h:58
0x7efcea172026 __libc_start_main_impl
../csu/libc-start.c:360
Please submit a full bug report, with preprocessed source (by using
-freport-bug).
Please include the complete backtrace with any bug report.
See <file:///usr/share/doc/gcc-15/README.Bugs> for instructions.
$
$ cat z.f90
module m
implicit none
type :: inner
integer :: x = 0
contains
final :: inner_final
end type
type :: outer
type(inner), allocatable :: items(:)
logical :: available
end type
interface outer
module procedure :: constructor_outer
end interface
contains
subroutine inner_final(this)
type(inner), intent(inout) :: this
end subroutine
subroutine save_vals(o, i)
class(outer), intent(inout) :: o(:)
type(inner), intent(in) :: i(:)
o(pick_first(o%available, size(o)))%items = i
end subroutine
function pick_first(a, n) result(r)
integer, intent(in) :: n
logical, intent(inout) :: a(n)
integer :: r
r = findloc(a, .true., dim=1)
a(r) = .false.
end function
function constructor_outer(n) result(r)
integer, intent(in) :: n
type(outer) :: r
allocate(r%items(n))
r%available = .true.
end function
end module
program p
use m
implicit none
type(outer), allocatable :: x(:)
integer :: failures = 0
allocate(x(5), source = outer(3))
call save_vals(x, [inner(-1)])
print *, x(1)%available
print *, x(2)%available
if (x(1)%available) then
call add_failure(failures, 1)
else
print *, "size1=", size(x(1)%items)
if (size(x(1)%items) /= 1) then
call add_failure(failures, 2)
else
print *, x(1)%items(1)%x
if (x(1)%items(1)%x /= -1) call add_failure(failures, 4)
end if
end if
if (.not. x(2)%available) then
call add_failure(failures, 8)
print *, 'size2=', size(x(2)%items)
print *, x(2)%items(1)%x
end if
if (failures /= 0) error stop failures
contains
subroutine add_failure(var, val)
integer, intent(inout) :: var
integer, intent(in) :: val
var = ior(var, val)
end subroutine
end program
