https://gcc.gnu.org/g:1da2423372115bf33c9885ccd681ca800d848e49

commit r16-9111-g1da2423372115bf33c9885ccd681ca800d848e49
Author: Jerry DeLisle <[email protected]>
Date:   Thu Jun 11 18:50:37 2026 -0700

    fortran: [PR125535] Plug remaining leak in implied-do array constructor 
with allocatable components
    
    Follow-up to the PR fortran/125535 wrong-code fix (commit 1b8421e9d5b,
    already pushed): that fix corrected the *values* produced by an
    implied-do array constructor of derived-type function results with
    allocatable components, but left a separate memory leak in the same
    code path.
    
    An array constructor whose implied-do produces function results of a
    derived type with allocatable components moves each result into the
    constructor temporary, so the temporary owns those components.  The
    per-element finalization in gfc_trans_array_ctor_element only freed
    the single slot referenced by the final loop offset, leaking the
    allocatable components of every other element the loop produced.
    
    A whole-array sweep is the only way to free every slot written by an
    implied-do, but it may be used only when every element is an owned
    function result: a variable element is shallow-copied into the
    temporary and its components are aliased rather than owned, so freeing
    them would double free.  Add gfc_constructor_is_owned_alloc_comp to
    detect the all-owned case and, when it holds, suppress the per-element
    finalization and emit a single gfc_deallocate_alloc_comp_no_caf over
    the whole temporary.
    
    Assisted-by: Claude Opus 4.8
    
            PR fortran/125535
    
    gcc/fortran/ChangeLog:
    
            * trans-array.cc (gfc_constructor_is_owned_alloc_comp): New 
function.
            (gfc_trans_array_constructor_value): Add OWNED_SWEEP parameter and,
            when set, suppress the per-element finalization.  Pass it through 
the
            recursive call.
            (trans_array_constructor): Compute OWNED_SWEEP and, when set,
            deallocate the allocatable components of the whole temporary in one
            sweep.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/asan/implied_do_alloc_comp_leak_1.f90: New test.
    
    (cherry picked from commit b2ec4ebcf914f32f51c35dbd9a2c98dab5841097)

Diff:
---
 gcc/fortran/trans-array.cc                         | 70 ++++++++++++++++++++--
 .../asan/implied_do_alloc_comp_leak_1.f90          | 45 ++++++++++++++
 2 files changed, 110 insertions(+), 5 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cb55e5082d4f..ba8753199d94 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2143,17 +2143,56 @@ gfc_trans_array_constructor_subarray (stmtblock_t * 
pblock,
 }
 
 
+/* Return true if every leaf element of an array constructor is a function
+   reference returning derived type DER, which has allocatable components.
+   Such results are moved (shallow-copied) into the constructor temporary, so
+   the temporary owns their allocatable components and they can all be freed
+   in a single sweep over the whole temporary.  Returns false as soon as an
+   element is anything else - notably a variable, whose allocatable components
+   are aliased rather than owned by the temporary and must not be freed.  */
+
+static bool
+gfc_constructor_is_owned_alloc_comp (gfc_constructor_base base,
+                                    gfc_symbol *der)
+{
+  gfc_constructor *c;
+
+  if (base == NULL)
+    return false;
+
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      gfc_expr *e = c->expr;
+      if (e->expr_type == EXPR_ARRAY)
+       {
+         if (!gfc_constructor_is_owned_alloc_comp (e->value.constructor, der))
+           return false;
+       }
+      else if (!(e->expr_type == EXPR_FUNCTION
+                && e->ts.type == BT_DERIVED
+                && e->ts.u.derived == der))
+       return false;
+    }
+  return true;
+}
+
+
 /* Assign the values to the elements of an array constructor.  DYNAMIC
    is true if descriptor DESC only contains enough data for the static
    size calculated by gfc_get_array_constructor_size.  When true, memory
-   for the dynamic parts must be allocated using realloc.  */
+   for the dynamic parts must be allocated using realloc.  OWNED_SWEEP is
+   true when the caller will free the allocatable components of every
+   constructor element in one sweep over the whole temporary; in that case
+   the per-element finalization built here is suppressed to avoid a double
+   free.  */
 
 static void
 gfc_trans_array_constructor_value (stmtblock_t * pblock,
                                   stmtblock_t * finalblock,
                                   tree type, tree desc,
                                   gfc_constructor_base base, tree * poffset,
-                                  tree * offsetvar, bool dynamic)
+                                  tree * offsetvar, bool dynamic,
+                                  bool owned_sweep)
 {
   tree tmp;
   tree start = NULL_TREE;
@@ -2221,7 +2260,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
          /* Array constructors can be nested.  */
          gfc_trans_array_constructor_value (&body, finalblock, type,
                                             desc, c->expr->value.constructor,
-                                            poffset, offsetvar, dynamic);
+                                            poffset, offsetvar, dynamic,
+                                            owned_sweep);
        }
       else if (c->expr->rank > 0)
        {
@@ -2257,7 +2297,11 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
              *poffset = fold_build2_loc (input_location, PLUS_EXPR,
                                          gfc_array_index_type,
                                          *poffset, gfc_index_one_node);
-             if (finalblock)
+             /* Unless the whole temporary is being swept by the caller, add
+                the per-element finalization.  The sweep is used when every
+                element is an owned function result, which is the only way to
+                correctly free elements produced inside an implied-do loop.  */
+             if (finalblock && !owned_sweep)
                gfc_add_block_to_block (finalblock, &se.finalblock);
            }
          else
@@ -2910,6 +2954,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   char *msg;
   stmtblock_t finalblock;
   bool finalize_required;
+  bool owned_sweep = false;
 
   /* Save the old values for nested checking.  */
   old_first_len = first_len;
@@ -3095,10 +3140,25 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   if (IS_PDT (expr))
    finalize_required = true;
 
+  /* If every element of the constructor is a function result with allocatable
+     components, those components are owned by the temporary and are freed in a
+     single sweep over the whole array below.  This is the only way to free the
+     elements produced inside an implied-do loop, where a single compile-time
+     element stands for many runtime elements.  */
+  owned_sweep = finalize_required
+    && expr->ts.type == BT_DERIVED
+    && expr->ts.u.derived->attr.alloc_comp
+    && gfc_constructor_is_owned_alloc_comp (c, expr->ts.u.derived);
+
   gfc_trans_array_constructor_value (&outer_loop->pre,
                                     finalize_required ? &finalblock : NULL,
                                     type, desc, c, &offset, &offsetvar,
-                                    dynamic);
+                                    dynamic, owned_sweep);
+
+  if (owned_sweep)
+    gfc_add_expr_to_block (&finalblock,
+                          gfc_deallocate_alloc_comp_no_caf (expr->ts.u.derived,
+                                                            desc, 1, true));
 
   /* If the array grows dynamically, the upper bound of the loop variable
      is determined by the array's final upper bound.  */
diff --git a/gcc/testsuite/gfortran.dg/asan/implied_do_alloc_comp_leak_1.f90 
b/gcc/testsuite/gfortran.dg/asan/implied_do_alloc_comp_leak_1.f90
new file mode 100644
index 000000000000..8d87617be00f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/implied_do_alloc_comp_leak_1.f90
@@ -0,0 +1,45 @@
+!{ dg-do run }
+
+! PR fortran/XYZZY
+
+! An array constructor with an implied-do whose element is a function result
+! of derived type with allocatable components moves the result into the
+! constructor temporary, which then owns those components.  The per-element
+! finalization only freed the last slot written by the loop, leaking the
+! allocatable components of every other element.  Checked under 
-fsanitize=address.
+
+module m
+  implicit none
+  type :: t
+    real, allocatable :: v(:)
+  end type
+contains
+  pure function make (x) result (r)
+    real, intent(in) :: x(:)
+    type(t) :: r
+    r%v = x
+  end function
+end module
+
+program implied_do_alloc_comp_leak_1
+  use m
+  implicit none
+  integer, parameter :: n = 4
+  type(t), allocatable :: a(:), b(:,:)
+  real :: h(2, n)
+  integer :: i, j
+
+  do i = 1, n
+    h(:, i) = [real(i), real(2 * i)]
+  end do
+
+  ! Flat implied-do of function results.
+  a = [(make (h(:, i)), i = 1, n)]
+  if (any (a(n)%v /= h(:, n))) stop 1
+  deallocate (a)
+
+  ! Nested implied-do feeding a transformational intrinsic.
+  b = reshape ([([(make (h(:, i)), j = 1, 1)], i = 1, n)], [1, n])
+  if (any (b(1, 2)%v /= h(:, 2))) stop 2
+  deallocate (b)
+end program

Reply via email to