[Fortran, Patch, PR119380, v1] Fix freeing procedure pointers in components

[Andre Vehreschild]

Hi all,

attached patch fixes freeing of procedure pointers that are stored in a derived
type's component. GFortran did that already for polymorphic types but missed
out on the others.

Regtested ok on x86_64-pc-linux-gnu / F41. Ok for mainline?

Regards,
        Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de

From 9a77974f8120564846f672f28650100d158f365d Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri, 21 Mar 2025 09:13:29 +0100
Subject: [PATCH] Fortran: Fix freeing procedure pointer components [PR119380]

	PR fortran/119380

gcc/fortran/ChangeLog:

	* trans-array.cc (structure_alloc_comps): Prevent freeing of
	procedure pointer components.

gcc/testsuite/ChangeLog:

	* gfortran.dg/proc_ptr_comp_54.f90: New test.
---
 gcc/fortran/trans-array.cc                    |  2 +-
 .../gfortran.dg/proc_ptr_comp_54.f90          | 30 +++++++++++++++++++
 2 files changed, 31 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e9eacf20128..960613167f7 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10109,7 +10109,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	  else
 	    {
 	      attr = &c->attr;
-	      if (attr->pointer)
+	      if (attr->pointer || attr->proc_pointer)
 		continue;
 	    }

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90
new file mode 100644
index 00000000000..73abc590e9e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90
@@ -0,0 +1,30 @@
+!{ dg-do run }
+
+! Check that components of procedure pointer aren't freeed.
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+
+  implicit none
+
+  type foo_t
+    integer, allocatable :: i_
+    procedure(f), pointer, nopass :: f_
+    procedure(c), pointer, nopass :: c_
+  end type
+
+  class(foo_t), allocatable :: ff
+
+  associate(foo => foo_t(1,f))
+  end associate
+
+contains
+
+  function f()
+    logical, allocatable :: f
+    f = .true.
+  end function
+
+  function c()
+    class(foo_t), allocatable :: c
+    allocate(c)
+  end function
+end
--
2.49.0