https://gcc.gnu.org/bugzilla/show_bug.cgi?id=125391
--- Comment #17 from Mikael Morin <mikael at gcc dot gnu.org> ---
(In reply to Mikael Morin from comment #11)
> The pre and post block dropped would be automatically fixed if the double
> evaluation is fixed.
Here is an example nevertheless. In this variant of comment #16, the variable
isn't out of scope, but it's still used uninitialized.
Tested with 15.2 and patched master.
$ gfortran -static y.f90 -o y
$ ./y
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
(... blah blah ...)
$ cat y.f90
module m
implicit none
type :: inner
integer :: x = 0
contains
final :: inner_final
end type
type :: outer
type(inner), allocatable :: item
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_val(o, i)
class(outer), intent(inout) :: o(:)
type(inner), intent(in) :: i
o(pick_first(o%available, size(o)))%item = 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() result(r)
type(outer) :: r
allocate(r%item)
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())
call save_val(x, inner(-1))
print *, x(1)%available
print *, x(2)%available
if (x(1)%available) then
call add_failure(failures, 1)
else
print *, x(1)%item%x
end if
if (.not. x(2)%available) then
print *, x(2)%item%x
call add_failure(failures, 2)
end if
if (x(1)%item%x /= -1) call add_failure(failures, 4)
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
