https://gcc.gnu.org/g:4e1bbb0ac3183a0b3527ae2482f9de7014f266c3
commit r16-9075-g4e1bbb0ac3183a0b3527ae2482f9de7014f266c3 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. (cherry picked from commit cf6fe3baf828c3e6cbb4b1898ff702030ae06d5c) 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 5d194635ad6f..dcacf42e535c 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -4472,6 +4472,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++) @@ -4494,15 +4495,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); @@ -4523,7 +4528,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" } }
