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