Hello all,

I have been aware of this problem for a long time but did not get
around to fixing it:

Even if all the bounds of parameterized array components all
simplified to constants, gfortran has been setting the pdt_array
attribute, which results in unnecessary mallocs and frees. The same is
true of parameterized constant length character components.

The attached patch fixes the problem and passes regression testing on
FC44/x86_64.

OK for mainline and backporting to gcc-16?

Paul
From 2d88f13a509163c4e7e9ecb0e24db556c2502c62 Mon Sep 17 00:00:00 2001
From: Paul Thomas <[email protected]>
Date: Mon, 8 Jun 2026 12:20:40 +0100
Subject: [PATCH] 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.
---
 gcc/fortran/decl.cc                  | 10 ++++++++--
 gcc/testsuite/gfortran.dg/pdt_92.f03 | 25 +++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pdt_92.f03

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 722ce35f20c..9c124cb103d 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 00000000000..baaa1229302
--- /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" } }
-- 
2.54.0

Reply via email to