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
From 3ed3a61ea37d5e6d3a5aba64d8176ac8bbdb3f92 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@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 <shep...@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
