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:
parent
427f824258
commit
de915fbe3c
2 changed files with 51 additions and 6 deletions
|
@ -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,
|
||||
|
|
37
gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90
Normal file
37
gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90
Normal 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
|
||||
|
Loading…
Add table
Reference in a new issue