[Bug fortran/93762] Truncation of deferred-length string when passing as optional

[sgk at troutmask dot apl.washington.edu]

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

--- Comment #3 from Steve Kargl <sgk at troutmask dot apl.washington.edu> ---
Here's a better testcasei, which removes IO statement, which
makes it easier to read -fdump-tree-original.

module deepest_call_m
   implicit none
   contains
      subroutine deepest_call(str)
         character(len=:), allocatable, intent(out), optional :: str
         if (present(str)) then
            str = '12345'
            if (len(str) /= 5) stop 1
         end if
      end subroutine deepest_call
end module deepest_call_m

module interface_call_m
   implicit none
   contains
      subroutine interface_call(str)
         use deepest_call_m, only : deepest_call
         character(len=:), allocatable, intent(out), optional :: str
         if (present(str)) then
            call deepest_call(str)
            if (len(str) /= 5) stop 2
         end if
      end subroutine interface_call
end module interface_call_m

program main
   use interface_call_m, only : interface_call
   implicit none
   character(len=:), allocatable :: str
   call interface_call(str)
   if (len(str) /= 5) stop 3
end program main

Here's the -fdump-tree-original where I have removed
inconsequential code and re-ordered to help with thinking.
Comments are in-lined.

MAIN__ ()
{
  integer(kind=4) .str;
  character(kind=1)[1:.str] * str;

  str = 0B;
  interface_call (&str, &.str);  /* .str is not set to some value. */ 
}

interface_call (character(kind=1)[1:*_str] * * str, integer(kind=4) * _str)
{
  if (str != 0B)
    {
      {

        /* This is not good.  *_str has the value of .str from MAIN,
           which wasn't set. */

        character(kind=1)[1:*_str] * *D.3819;
        integer(kind=4) D.3820;

        /* Remove freeing from intent(out) attribute. */

        D.3819 = str != 0B ? str : 0B;
        D.3820 = str != 0B ? *_str : 0;

        /* Here D.3820 is 0. */
        deepest_call (D.3819, &D.3820);

        /* *_str should be set to D.3820, but isn't. */
      }
    }
}

deepest_call (character(kind=1)[1:*_str] * * str, integer(kind=4) * _str)
{
  if (str != 0B)
    {
      {
        integer(kind=4) D.3808;
        integer(kind=4) D.3809;

        /* Handle intent(out) and/or re-allocation on assign. */

        /* Set *_str to 5, which is the desired length. */
        *_str = 5;
        D.3808 = *_str;
        if (D.3808 > 0)
          {
             /* Copy '12345' into str. */
          }
      }
    }
}

So, yep!  The string length is not propagated up the call chain.