Fortran: Break recursion building recursive types. [PR106606]

Build a derived type component's type only, when it is not already being
built 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 built.

gcc/testsuite/ChangeLog:

	* gfortran.dg/recursive_alloc_comp_5.f90: New test.
This commit is contained in:
Andre Vehreschild 2024-08-23 16:28:38 +02:00
parent 427f824258
commit de915fbe3c
2 changed files with 51 additions and 6 deletions

View file

@ -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,

View file

@ -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