[gcc r14-9049] fortran: gfc_trans_subcomponent_assign fixes [PR113503]

[gcc r14-9049] fortran: gfc_trans_subcomponent_assign fixes [PR113503]

[Jakub Jelinek]

https://gcc.gnu.org/g:296284a9dbb7df4485cc5f1d3e975fdb4b8a10b8

commit r14-9049-g296284a9dbb7df4485cc5f1d3e975fdb4b8a10b8
Author: Jakub Jelinek <jakub@redhat.com>
Date:   Sat Feb 17 16:54:08 2024 +0100

    fortran: gfc_trans_subcomponent_assign fixes [PR113503]
    
    The r14-870 changes broke xtb package tests (reduced testcase is the first
    one below) and caused ICEs on a test derived from that (the second one).
    For the
      x = T(u = trim (us(1)))
    statement, before that change gfortran used to emit weird code with
    2 trim calls:
          _gfortran_string_trim (&len.2, (void * *) &pstr.1, 20, &us[0]);
          if (len.2 > 0)
            {
              __builtin_free ((void *) pstr.1);
            }
          D.4275 = len.2;
          t.0.u = (character(kind=1)[1:0] *) __builtin_malloc (MAX_EXPR <(sizetype) D.4275, 1>);
          t.0._u_length = D.4275;
          _gfortran_string_trim (&len.4, (void * *) &pstr.3, 20, &us[0]);
          (void) __builtin_memcpy ((void *) t.0.u, (void *) pstr.3, (unsigned long) NON_LVALUE_EXPR <len.4>);
          if (len.4 > 0)
            {
              __builtin_free ((void *) pstr.3);
            }
    That worked at runtime, though it is wasteful.
    That commit changed it to:
          slen.3 = len.2;
          t.0.u = (character(kind=1)[1:0] *) __builtin_malloc (MAX_EXPR <(sizetype) slen.3, 1>);
          t.0._u_length = slen.3;
          _gfortran_string_trim (&len.2, (void * *) &pstr.1, 20, &us[0]);
          (void) __builtin_memcpy ((void *) t.0.u, (void *) pstr.1, (unsigned long) NON_LVALUE_EXPR <len.2>);
          if (len.2 > 0)
            {
              __builtin_free ((void *) pstr.1);
            }
    which results in -Wuninitialized warning later on and if one is unlucky and
    the uninitialized len.2 variable is smaller than the trimmed length, it
    results in heap overflow and often crashes later on.
    The bug above is clear, len.2 is only initialized in the
    _gfortran_string_trim (&len.2, (void * *) &pstr.1, 20, &us[0]);
    call, but used before that.  Now, the
          slen.3 = len.2;
          t.0.u = (character(kind=1)[1:0] *) __builtin_malloc (MAX_EXPR <(sizetype) slen.3, 1>);
          t.0._u_length = slen.3;
    statements come from the alloc_scalar_allocatable_subcomponent call,
    while
          _gfortran_string_trim (&len.2, (void * *) &pstr.1, 20, &us[0]);
    from the gfc_conv_expr (&se, expr); call which is done before the
    alloc_scalar_allocatable_subcomponent call, but is only appended later on
    with gfc_add_block_to_block (&block, &se.pre);
    Now, obviously the alloc_scalar_allocatable_subcomponent emitted statements
    can depend on the se.pre sequence statements which can compute variables
    used by alloc_scalar_allocatable_subcomponent like the length.
    On the other side, I think the se.pre sequence really shouldn't depend
    on the changes done by alloc_scalar_allocatable_subcomponent, that is
    initializing the FIELD_DECLs of the destination allocatable subcomponent
    only, the gfc_conv_expr statements are already created, so all they could
    in theory depend above is on t.0.u or t.0._u_length, but I believe if the
    rhs dependened on the lhs content (which is allocated by those statements
    but really uninitialized), it would need to be discovered by the dependency
    analysis and forced into a temporary.
    So, in order to fix the first testcase, the second hunk of the patch just
    emits the se.pre block before the alloc_scalar_allocatable_subcomponent
    changes rather than after it.
    
    The second problem is an ICE on the second testcase.  expr in the caller
    (expr2 inside of alloc_scalar_allocatable_subcomponent) has
    expr2->ts.u.cl->backend_decl already set, INTEGER_CST 20, but
    alloc_scalar_allocatable_subcomponent overwrites it to a new VAR_DECL
    which it assigns a value to before the malloc.  That can work if the only
    places the expr2->ts is ever used are in the same local block or its
    subblocks (and only if it is dominated by the code emitted by
    alloc_scalar_allocatable_subcomponent, so e.g. not if that call is inside
    of a conditional code and use later unconditional), but doesn't work
    if expr2->ts is used before that block or after it.  So, the exact ICE is
    because of:
      slen.1 = 20;
        static character(kind=1) us[1][1:20] = {"foo                 "};
      x.u = 0B;
      x._u_length = 0;
      {
        struct t t.0;
        struct t D.4308;
    
        {
          integer(kind=8) slen.1;
    
          slen.1 = 20;
          t.0.u = (character(kind=1)[1:0] *) __builtin_malloc (MAX_EXPR <(sizetype) slen.1, 1>);
          t.0._u_length = slen.1;
          (void) __builtin_memcpy ((void *) t.0.u, (void *) &us[0], 20);
        }
    where the first slen.1 = 20; is emitted because it sees us has a VAR_DECL
    ts.u.cl->backend_decl and so it wants to initialize it to the actual length.
    This is invalid GENERIC, because the slen.1 variable is only declared inside
    of a {} later on and so uses outside of it are wrong.  Similarly wrong would
    be if it is used later on.  E.g. in the same testcase if it has
      type(T) :: x, y
      x = T(u = us(1))
      y%u = us(1)
    then there is
        {
          integer(kind=8) slen.1;
    
          slen.1 = 20;
          t.0.u = (character(kind=1)[1:0] *) __builtin_malloc (MAX_EXPR <(sizetype) slen.1, 1>);
          t.0._u_length = slen.1;
          (void) __builtin_memcpy ((void *) t.0.u, (void *) &us[0], 20);
        }
    ...
        if (y.u != 0B) goto L.1;
        y.u = (character(kind=1)[1:0] *) __builtin_malloc (MAX_EXPR <(sizetype) slen.1, 1>);
    i.e. another use of slen.1, this time after slen.1 got out of scope.
    
    I really don't understand why the code modifies
    expr2->ts.u.cl->backend_decl, expr2 isn't used there anywhere except for
    expr2->ts.u.cl->backend_decl expressions, so hacks like save the previous
    value, overwrite it temporarily over some call that will use expr2 and
    restore afterwards aren't needed - there are no such calls, so the
    following patch fixes it just by not messing up with
    expr2->ts.u.cl->backend_decl, only set it to size variable and overwrite
    that with a temporary if needed.
    
    2024-02-17  Jakub Jelinek  <jakub@redhat.com>
    
            PR fortran/113503
            * trans-expr.cc (alloc_scalar_allocatable_subcomponent): Don't
            overwrite expr2->ts.u.cl->backend_decl, instead set size to
            expr2->ts.u.cl->backend_decl first and use size instead of
            expr2->ts.u.cl->backend_decl.
            (gfc_trans_subcomponent_assign): Emit se.pre into block
            before calling alloc_scalar_allocatable_subcomponent instead of
            after it.
    
            * gfortran.dg/pr113503_1.f90: New test.
            * gfortran.dg/pr113503_2.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc                | 18 ++++++++----------
 gcc/testsuite/gfortran.dg/pr113503_1.f90 | 18 ++++++++++++++++++
 gcc/testsuite/gfortran.dg/pr113503_2.f90 | 12 ++++++++++++
 3 files changed, 38 insertions(+), 10 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a0593b76f18f..3506e4e4cb0b 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9059,13 +9059,10 @@ alloc_scalar_allocatable_subcomponent (stmtblock_t *block, tree comp,
   if (cm->ts.type == BT_CHARACTER && cm->ts.deferred)
     {
       gcc_assert (expr2->ts.type == BT_CHARACTER);
-      if (!expr2->ts.u.cl->backend_decl
-	  || !VAR_P (expr2->ts.u.cl->backend_decl))
-	expr2->ts.u.cl->backend_decl = gfc_create_var (TREE_TYPE (slen),
-						       "slen");
-      gfc_add_modify (block, expr2->ts.u.cl->backend_decl, slen);
-
       size = expr2->ts.u.cl->backend_decl;
+      if (!size || !VAR_P (size))
+	size = gfc_create_var (TREE_TYPE (slen), "slen");
+      gfc_add_modify (block, size, slen);
 
       gfc_deferred_strlen (cm, &tmp);
       lhs_cl_size = fold_build3_loc (input_location, COMPONENT_REF,
@@ -9253,19 +9250,20 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm,
 	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
 	       && expr->ts.type != BT_CLASS)))
     {
+      tree size;
+
       gfc_init_se (&se, NULL);
       gfc_conv_expr (&se, expr);
-      tree size;
 
+      /* The remainder of these instructions follow the if (cm->attr.pointer)
+	 if (!cm->attr.dimension) part above.  */
+      gfc_add_block_to_block (&block, &se.pre);
       /* Take care about non-array allocatable components here.  The alloc_*
 	 routine below is motivated by the alloc_scalar_allocatable_for_
 	 assignment() routine, but with the realloc portions removed and
 	 different input.  */
       alloc_scalar_allocatable_subcomponent (&block, dest, cm, expr,
 					     se.string_length);
-      /* The remainder of these instructions follow the if (cm->attr.pointer)
-	 if (!cm->attr.dimension) part above.  */
-      gfc_add_block_to_block (&block, &se.pre);
 
       if (expr->symtree && expr->symtree->n.sym->attr.proc_pointer
 	  && expr->symtree->n.sym->attr.dummy)
diff --git a/gcc/testsuite/gfortran.dg/pr113503_1.f90 b/gcc/testsuite/gfortran.dg/pr113503_1.f90
new file mode 100644
index 000000000000..37c178e2ca8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr113503_1.f90
@@ -0,0 +1,18 @@
+! PR fortran/113503
+! { dg-do compile }
+! { dg-options "-O2 -fno-inline -Wuninitialized" }
+
+program pr113503
+  implicit none
+  type :: T
+    character(len=:), allocatable :: u
+  end type
+  character(len=20) :: us(1) = 'foobar'
+  type(T) :: x
+  x = T(u = trim (us(1))) ! { dg-bogus "is used uninitialized" }
+  call foo
+contains
+  subroutine foo
+    if (x%u /= 'foobar') stop 1
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/pr113503_2.f90 b/gcc/testsuite/gfortran.dg/pr113503_2.f90
new file mode 100644
index 000000000000..9dfb245fc432
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr113503_2.f90
@@ -0,0 +1,12 @@
+! PR fortran/113503
+! { dg-do compile }
+
+program pr113503
+  implicit none
+  type :: T
+    character(len=:), allocatable :: u
+  end type
+  character(len=20) :: us(1) = 'foo'
+  type(T) :: x
+  x = T(u = us(1))
+end