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.

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 3a1ff98b33c3284c6aa3ebd23479aea289c9a0b6..96ef8b49fbef2c57354be23131109baeb0a64b75 100644 (file)
--- 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 (file)
index 0000000..f26d6a8
--- /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
+