[Bug fortran/69423] [6 Regression] Invalid optimization with deferred-length character

["pault at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=69423

--- Comment #10 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 37686
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=37686&action=edit
Provisional patch for the PR

I have reworked the handling of deferred string function results to fix this
PR. Clearly, using the indirect reference to the passed string length is
unsafe; whether an optimization bug or not. It's a pity because it was quite
elegant! Instead, I have used the original approach of an in-scope character
length, which is nulled on entry and assigned to the result length on exit.
Catching all the various cases took quite a lot of rummaging around in
trans-decl.c(gfc_trans_deferred_vars)!

The patch is attached. It needs a LOT of cleaning up before submission, which i
hope to accomplish in the coming couple of days. However, it regtests OK on the
current trunk as it stands. The corresponding deja-gnu-ified testcase is copied
below.

Paul

! { dg-do run }
!
! Test the fix for PR69423.
!
! Contributed by Antony Lewis  <antony@cosmologist.info>
!
program tester
  character(LEN=:), allocatable :: S
  S= test(2)
  if (len(S) .ne. 4) call abort
  if (S .ne. "test") call abort
  if (allocated (S)) deallocate (S)

  S= test2(2)
  if (len(S) .ne. 4) call abort
  if (S .ne. "test") call abort
  if (allocated (S)) deallocate (S)
contains
  function test(alen)
    character(LEN=:), allocatable :: test
    integer alen, i
    do i = alen, 1, -1
      test = 'test'
      exit
    end do
!       This line would print nothing when compiled with -O1 and higher.
!       print *, len(test),test
    if (len(test) .ne. 4) call abort
    if (test .ne. "test") call abort
  end function test

  function test2(alen) result (test)
    character(LEN=:), allocatable :: test
    integer alen, i
    do i = alen, 1, -1
      test = 'test'
      exit
    end do
!       This worked before the fix.
!       print *, len(test),test
    if (len(test) .ne. 4) call abort
    if (test .ne. "test") call abort
  end function test2
end program tester