diff mbox series

[Fortran,PR106606,v1] Fortran: Break recursion building recursive types. [PR106606]

Message ID 20240918140159.4d823fd7@vepi2
State New
Headers show
Series [Fortran,PR106606,v1] Fortran: Break recursion building recursive types. [PR106606] | expand

Commit Message

Andre Vehreschild Sept. 18, 2024, 12:01 p.m. UTC 
Hi all,

Paul asked me to have a look at his approach for pr106606. Now here is my
solution. I needed to break the endless recursion of a derived type referencing
itself in a component (like in a linked list). I accomplished this by checking,
if a type is in the build (i.e. if its size has not been computed; checking if
no FIELD_DECLs are present, lead to errors when in the middle of constructing a
type). So, when now a derived type uses itself (directly or implicitly) using
a pointer style component (pointer, allocatable...) then it is not build again,
but only the address to the incomplete type is used (a POINTER_TYPE tree is
created). This is sufficient to layout the type and later on the RECORD_TYPE
will be completed and everything is fine.

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

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

Comments

Thomas Koenig Sept. 18, 2024, 4:24 p.m. UTC | #1 
Hi Andre,

> Regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?

Extremely minor nit: In the commit message and ChangeLog entry,

Build a derived type component's type only, when it is not already being
build and the component uses pointer semantics.

I believe that should be "being built".

In the ChangeLog entry

	derived types as component's types when they are not yet build.

s/build/built/

OK for trunk.

Thanks for the patch!

Best regards

	Thomas
Andre Vehreschild Sept. 19, 2024, 10:18 a.m. UTC | #2 
Hi Thomas,

thanks for review. Committed with the changes requested as:
gcc-15-3711-gde915fbe3cb

Thanks again.

Regards,
	Andre

On Wed, 18 Sep 2024 18:24:19 +0200
Thomas Koenig <tkoenig@netcologne.de> wrote:

> Hi Andre,
>
> > Regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
>
> Extremely minor nit: In the commit message and ChangeLog entry,
>
> Build a derived type component's type only, when it is not already being
> build and the component uses pointer semantics.
>
> I believe that should be "being built".
>
> In the ChangeLog entry
>
> 	derived types as component's types when they are not yet build.
>
> s/build/built/
>
> OK for trunk.
>
> Thanks for the patch!
>
> Best regards
>
> 	Thomas
>
>


--
Andre Vehreschild * Email: vehre ad gmx dot de
diff mbox series

Patch

From 3ed3a61ea37d5e6d3a5aba64d8176ac8bbdb3f92 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 23 Aug 2024 16:28:38 +0200
Subject: [PATCH] Fortran: Break recursion building recursive types. [PR106606]

Build a derived type component's type only, when it is not already being
build and the component uses pointer semantics.

gcc/fortran/ChangeLog:

	PR fortran/106606

	* trans-types.cc (gfc_get_derived_type): Only build non-pointer
	derived types as component's types when they are not yet build.

gcc/testsuite/ChangeLog:

	* gfortran.dg/recursive_alloc_comp_5.f90: New test.
---
 gcc/fortran/trans-types.cc                    | 20 +++++++---
 .../gfortran.dg/recursive_alloc_comp_5.f90    | 37 +++++++++++++++++++
 2 files changed, 51 insertions(+), 6 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 3a1ff98b33c..96ef8b49fbe 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2905,18 +2905,26 @@  gfc_get_derived_type (gfc_symbol * derived, int codimen)
      will be built and so we can return the type.  */
   for (c = derived->components; c; c = c->next)
     {
-      bool same_alloc_type = c->attr.allocatable
-			     && derived == c->ts.u.derived;
-
       if (c->ts.type == BT_UNION && c->ts.u.derived->backend_decl == NULL)
         c->ts.u.derived->backend_decl = gfc_get_union_type (c->ts.u.derived);

       if (c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS)
 	continue;

-      if ((!c->attr.pointer && !c->attr.proc_pointer
-	  && !same_alloc_type)
-	  || c->ts.u.derived->backend_decl == NULL)
+      const bool incomplete_type
+	= c->ts.u.derived->backend_decl
+	  && TREE_CODE (c->ts.u.derived->backend_decl) == RECORD_TYPE
+	  && !(TYPE_LANG_SPECIFIC (c->ts.u.derived->backend_decl)
+	       && TYPE_LANG_SPECIFIC (c->ts.u.derived->backend_decl)->size);
+      const bool pointer_component
+	= c->attr.pointer || c->attr.allocatable || c->attr.proc_pointer;
+
+      /* Prevent endless recursion on recursive types (i.e. types that reference
+	 themself in a component.  Break the recursion by not building pointers
+	 to incomplete types again, aka types that are already in the build.  */
+      if (c->ts.u.derived->backend_decl == NULL
+	  || (c->attr.codimension && c->as->corank != codimen)
+	  || !(incomplete_type && pointer_component))
 	{
 	  int local_codim = c->attr.codimension ? c->as->corank: codimen;
 	  c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived,
diff --git a/gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90 b/gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90
new file mode 100644
index 00000000000..f26d6a8da38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90
@@ -0,0 +1,37 @@ 
+!{ dg-do run }
+
+! Check that PR106606 is fixed.
+
+! Contributed by Ron Shepard  <shepard@tcg.anl.gov>
+
+module bst_base_mod
+
+  ! Binary Search Tree Module
+
+  implicit none
+
+  public
+
+  type, abstract :: bst_base_node_type
+    class(bst_base_node_type), allocatable :: left
+    class(bst_base_node_type), allocatable :: right
+  end type bst_base_node_type
+
+  type, extends (bst_base_node_type) :: bst_base
+    integer :: bst_base_value
+  end type bst_base
+
+end module bst_base_mod
+
+  use bst_base_mod
+
+  class (bst_base), allocatable :: root
+
+  allocate (root, source = bst_base (NULL(), NULL(), 0))
+  root%left = bst_base (NULL(), NULL(), 1)
+  root%right = bst_base (NULL(), NULL(), 2)
+
+  if (.not. allocated(root%left)) stop 1
+  if (.not. allocated(root%right)) stop 2
+end
+
--
2.46.0