https://gcc.gnu.org/g:cf6fe3baf828c3e6cbb4b1898ff702030ae06d5c

commit r17-1436-gcf6fe3baf828c3e6cbb4b1898ff702030ae06d5c
Author: Paul Thomas <[email protected]>
Date:   Mon Jun 8 12:20:40 2026 +0100

    Fortran: [PDT] Prevent unnecessary mallocs and frees. [PR125669]
    
    2026-06-07  Paul Thomas  <[email protected]>
    
    gcc/fortran
            PR fortran/125669
            * decl.cc (gfc_get_pdt_instance): If the bound expressions for
            and array component, of the length expression for a character
            component, gave simplified to a constant, do not set attributes
            pdt_array and pdt_string respectively.
    
    gcc/testsuite/
            PR fortran/125669
            * gfortran.dg/pdt_92.f03: New test.

Diff:
---
 gcc/fortran/decl.cc                  | 10 ++++++++--
 gcc/testsuite/gfortran.dg/pdt_92.f03 | 25 +++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 722ce35f20c2..9c124cb103d2 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4503,6 +4503,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, 
gfc_symbol **sym,
       if (c1->as && c1->as->type == AS_EXPLICIT)
        {
          bool pdt_array = false;
+         bool all_constant = true;
 
          /* Are the bounds of the array parameterized?  */
          for (i = 0; i < c1->as->rank; i++)
@@ -4525,15 +4526,19 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, 
gfc_symbol **sym,
                gfc_replace_expr (c2->as->lower[i], e);
              else
                gfc_free_expr (e);
+             if (c2->as->lower[i]->expr_type != EXPR_CONSTANT)
+               all_constant = false;
              e = gfc_copy_expr (c1->as->upper[i]);
              gfc_insert_kind_parameter_exprs (e);
              if (gfc_simplify_expr (e, 1))
                gfc_replace_expr (c2->as->upper[i], e);
              else
                gfc_free_expr (e);
+             if (c2->as->upper[i]->expr_type != EXPR_CONSTANT)
+               all_constant = false;
            }
 
-         c2->attr.pdt_array = 1;
+         c2->attr.pdt_array = all_constant ? 0 : 1;
          if (c1->initializer)
            {
              c2->initializer = gfc_copy_expr (c1->initializer);
@@ -4554,7 +4559,8 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, 
gfc_symbol **sym,
            gfc_replace_expr (c2->ts.u.cl->length, e);
          else
            gfc_free_expr (e);
-         c2->attr.pdt_string = 1;
+         if (c2->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+           c2->attr.pdt_string = 1;
        }
 
       /* Recurse into this function for PDT components.  */
diff --git a/gcc/testsuite/gfortran.dg/pdt_92.f03 
b/gcc/testsuite/gfortran.dg/pdt_92.f03
new file mode 100644
index 000000000000..baaa1229302d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_92.f03
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for pr125669, in which the components 'v' and 'c' below were
+! allocated and freed unnecessarily.
+!
+module m
+  implicit none
+  type :: t(k1, k2)
+    integer, kind :: k1, k2
+    real :: v(k1*k2, max(k1,k2))
+    character(len = k1+k2-1) :: c
+  end type
+end module
+
+program p
+  use m
+  implicit none
+  integer, parameter :: n=3, k=2
+  type(t(n,k)) :: x
+  if (any (shape(x%v) /= [6,3])) stop 1
+  if (len(x%c) /= 4) stop 2
+end program
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 0 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 0 "original" } }

Reply via email to