From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <gcc-bugzilla@gcc.gnu.org>
Received: by sourceware.org (Postfix, from userid 48)
 id A3F75385DC2C; Fri, 10 Apr 2020 23:10:49 +0000 (GMT)
DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A3F75385DC2C
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org;
 s=default; t=1586560249;
 bh=pUHY47Pfz+zlEzRaSd0HAN6PeYKcyKoUTa7xWnedfkk=;
 h=From:To:Subject:Date:In-Reply-To:References:From;
 b=YPXMel+cC1sXUGcZF3/TzagkEMhvQvgtnCmFStSSipN7yrCpw8Xdc5PmeDTXHnMBW
 IKLsM7P28w1hqmRFisJ1Vzfc2QoL6ydJBRXflaaKbfeQtGGDh+mpdNPnoRnPEa9ILn
 DFrzU7vEq6mYUvGmdIFIIt0uIfvWpxKvM7EI/BRM=
From: "sgk at troutmask dot apl.washington.edu" <gcc-bugzilla@gcc.gnu.org>
To: gcc-bugs@gcc.gnu.org
Subject: [Bug fortran/93762] Truncation of deferred-length string when
 passing as optional
Date: Fri, 10 Apr 2020 23:10:49 +0000
X-Bugzilla-Reason: CC
X-Bugzilla-Type: changed
X-Bugzilla-Watch-Reason: None
X-Bugzilla-Product: gcc
X-Bugzilla-Component: fortran
X-Bugzilla-Version: 8.2.0
X-Bugzilla-Keywords: 
X-Bugzilla-Severity: normal
X-Bugzilla-Who: sgk at troutmask dot apl.washington.edu
X-Bugzilla-Status: NEW
X-Bugzilla-Resolution: 
X-Bugzilla-Priority: P3
X-Bugzilla-Assigned-To: unassigned at gcc dot gnu.org
X-Bugzilla-Target-Milestone: ---
X-Bugzilla-Flags: 
X-Bugzilla-Changed-Fields: 
Message-ID: <bug-93762-4-6LMrPqhLte@http.gcc.gnu.org/bugzilla/>
In-Reply-To: <bug-93762-4@http.gcc.gnu.org/bugzilla/>
References: <bug-93762-4@http.gcc.gnu.org/bugzilla/>
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: quoted-printable
X-Bugzilla-URL: http://gcc.gnu.org/bugzilla/
Auto-Submitted: auto-generated
MIME-Version: 1.0
X-BeenThere: gcc-bugs@gcc.gnu.org
X-Mailman-Version: 2.1.29
Precedence: list
List-Id: Gcc-bugs mailing list <gcc-bugs.gcc.gnu.org>
List-Unsubscribe: <http://gcc.gnu.org/mailman/options/gcc-bugs>,
 <mailto:gcc-bugs-request@gcc.gnu.org?subject=unsubscribe>
List-Archive: <https://gcc.gnu.org/pipermail/gcc-bugs/>
List-Post: <mailto:gcc-bugs@gcc.gnu.org>
List-Help: <mailto:gcc-bugs-request@gcc.gnu.org?subject=help>
List-Subscribe: <http://gcc.gnu.org/mailman/listinfo/gcc-bugs>,
 <mailto:gcc-bugs-request@gcc.gnu.org?subject=subscribe>
X-List-Received-Date: Fri, 10 Apr 2020 23:10:49 -0000

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

--- 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=3D:), allocatable, intent(out), optional :: str
         if (present(str)) then
            str =3D '12345'
            if (len(str) /=3D 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=3D:), allocatable, intent(out), optional :: str
         if (present(str)) then
            call deepest_call(str)
            if (len(str) /=3D 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=3D:), allocatable :: str
   call interface_call(str)
   if (len(str) /=3D 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=3D4) .str;
  character(kind=3D1)[1:.str] * str;

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

interface_call (character(kind=3D1)[1:*_str] * * str, integer(kind=3D4) * _=
str)
{
  if (str !=3D 0B)
    {
      {

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

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

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

        D.3819 =3D str !=3D 0B ? str : 0B;
        D.3820 =3D str !=3D 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=3D1)[1:*_str] * * str, integer(kind=3D4) * _st=
r)
{
  if (str !=3D 0B)
    {
      {
        integer(kind=3D4) D.3808;
        integer(kind=3D4) D.3809;

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

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

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