re PR fortran/83183 (Out of memory with option -finit-derived)

2018-07-05  Fritz Reese  <fritzoreese@gmail.com>

    gcc/fortran/ChangeLog:

	PR fortran/83183
	PR fortran/86325
	* expr.c (class_allocatable, class_pointer, comp_allocatable,
	comp_pointer): New helpers.
	(component_initializer): Generate EXPR_NULL for allocatable or pointer
	components. Do not generate initializers for components within BT_CLASS.
	Do not assign to comp->initializer.
	(gfc_generate_initializer): Use new helpers; move code to generate
	EXPR_NULL for class allocatable components into component_initializer().

    gcc/testsuite/ChangeLog:

	PR fortran/83183
	PR fortran/86325
	* gfortran.dg/init_flag_18.f90: New testcase.
	* gfortran.dg/init_flag_19.f03: New testcase.

From-SVN: r262442

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b43c08358ce49cb49343f500f79419e8f34ab29a..f810379aea5d1e6457beb1bcef8c804dc3120b1f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2018-07-05  Fritz Reese  <fritzoreese@gmail.com>
+
+       PR fortran/83183
+       PR fortran/86325
+       * expr.c (class_allocatable, class_pointer, comp_allocatable,
+       comp_pointer): New helpers.
+       (component_initializer): Generate EXPR_NULL for allocatable or pointer
+       components. Do not generate initializers for components within BT_CLASS.
+       Do not assign to comp->initializer.
+       (gfc_generate_initializer): Use new helpers; move code to generate
+       EXPR_NULL for class allocatable components into component_initializer().
+
 2018-07-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/82009

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 951bdce98ac47cbbf097392c9089e9e4e68289fa..c5bf822cd24ddb3a2ba53df678f00c90514ed780 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4452,25 +4452,60 @@ get_union_initializer (gfc_symbol *union_type, gfc_component **map_p)
   return init;
 }
 
+static bool
+class_allocatable (gfc_component *comp)
+{
+  return comp->ts.type == BT_CLASS && CLASS_DATA (comp)
+    && CLASS_DATA (comp)->attr.allocatable;
+}
+
+static bool
+class_pointer (gfc_component *comp)
+{
+  return comp->ts.type == BT_CLASS && CLASS_DATA (comp)
+    && CLASS_DATA (comp)->attr.pointer;
+}
+
+static bool
+comp_allocatable (gfc_component *comp)
+{
+  return comp->attr.allocatable || class_allocatable (comp);
+}
+
+static bool
+comp_pointer (gfc_component *comp)
+{
+  return comp->attr.pointer
+    || comp->attr.pointer
+    || comp->attr.proc_pointer
+    || comp->attr.class_pointer
+    || class_pointer (comp);
+}
+
 /* Fetch or generate an initializer for the given component.
    Only generate an initializer if generate is true.  */
 
 static gfc_expr *
-component_initializer (gfc_typespec *ts, gfc_component *c, bool generate)
+component_initializer (gfc_component *c, bool generate)
 {
   gfc_expr *init = NULL;
 
-  /* See if we can find the initializer immediately.
-     Some components should never get initializers.  */
-  if (c->initializer || !generate
-      || (ts->type == BT_CLASS && !c->attr.allocatable)
-      || c->attr.pointer
-      || c->attr.class_pointer
-      || c->attr.proc_pointer)
+  /* Allocatable components always get EXPR_NULL.
+     Pointer components are only initialized when generating, and only if they
+     do not already have an initializer.  */
+  if (comp_allocatable (c) || (generate && comp_pointer (c) && !c->initializer))
+    {
+      init = gfc_get_null_expr (&c->loc);
+      init->ts = c->ts;
+      return init;
+    }
+
+  /* See if we can find the initializer immediately.  */
+  if (c->initializer || !generate)
     return c->initializer;
 
   /* Recursively handle derived type components.  */
-  if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+  else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
     init = gfc_generate_initializer (&c->ts, true);
 
   else if (c->ts.type == BT_UNION && c->ts.u.derived->components)
@@ -4518,7 +4553,7 @@ component_initializer (gfc_typespec *ts, gfc_component *c, bool generate)
       gfc_apply_init (&c->ts, &c->attr, init);
     }
 
-  return (c->initializer = init);
+  return init;
 }
 
 
@@ -4579,9 +4614,7 @@ gfc_generate_initializer (gfc_typespec *ts, bool generate)
   if (!generate)
     {
       for (; comp; comp = comp->next)
-        if (comp->initializer || comp->attr.allocatable
-            || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
-                && CLASS_DATA (comp)->attr.allocatable))
+       if (comp->initializer || comp_allocatable (comp))
           break;
     }
 
@@ -4597,7 +4630,7 @@ gfc_generate_initializer (gfc_typespec *ts, bool generate)
       gfc_constructor *ctor = gfc_constructor_get();
 
       /* Fetch or generate an initializer for the component.  */
-      tmp = component_initializer (ts, comp, generate);
+      tmp = component_initializer (comp, generate);
       if (tmp)
        {
          /* Save the component ref for STRUCTUREs and UNIONs.  */
@@ -4607,8 +4640,7 @@ gfc_generate_initializer (gfc_typespec *ts, bool generate)
 
           /* If the initializer was not generated, we need a copy.  */
           ctor->expr = comp->initializer ? gfc_copy_expr (tmp) : tmp;
-         if ((comp->ts.type != tmp->ts.type
-              || comp->ts.kind != tmp->ts.kind)
+         if ((comp->ts.type != tmp->ts.type || comp->ts.kind != tmp->ts.kind)
              && !comp->attr.pointer && !comp->attr.proc_pointer)
            {
              bool val;
@@ -4618,15 +4650,6 @@ gfc_generate_initializer (gfc_typespec *ts, bool generate)
            }
        }
 
-      if (comp->attr.allocatable
-         || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)->attr.allocatable))
-       {
-         ctor->expr = gfc_get_expr ();
-         ctor->expr->expr_type = EXPR_NULL;
-         ctor->expr->where = init->where;
-         ctor->expr->ts = comp->ts;
-       }
-
       gfc_constructor_append (&init->value.constructor, ctor);
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 33ac74025346ef0cab4e89f8ae9d75aec1166207..a812b5082411fb61799900211356431bcbbec347 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2018-07-05  Fritz Reese  <fritzoreese@gmail.com>
+
+       PR fortran/83183
+       PR fortran/86325
+       * gfortran.dg/init_flag_18.f90: New testcase.
+       * gfortran.dg/init_flag_19.f03: New testcase.
+
 2018-07-05  Carl Love  <cel@us.ibm.com>
        * gcc.target/altivec-1-runnable.c: New test file.
        * gcc.target/altivec-2-runnable.c: New test file.

diff --git a/gcc/testsuite/gfortran.dg/init_flag_18.f90 b/gcc/testsuite/gfortran.dg/init_flag_18.f90
new file mode 100644 (file)
index 0000000..9ab00a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_18.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-finit-derived" }
+!
+! PR fortran/83183
+!
+! Test a regression where -finit-derived recursed infinitely generating
+! initializers for allocatable components of the same derived type.
+!
+
+program pr83183
+  type :: linked_list
+     type(linked_list), allocatable :: link
+     integer :: value
+  end type
+  type(linked_list) :: test
+  allocate(test % link)
+  print *, test%value
+  print *, test%link%value
+end program

diff --git a/gcc/testsuite/gfortran.dg/init_flag_19.f03 b/gcc/testsuite/gfortran.dg/init_flag_19.f03
new file mode 100644 (file)
index 0000000..bbcee8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_19.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-finit-derived -finit-local-zero -fdump-tree-original" }
+!
+! Test initializers for BT_CLASS components/variables with -finit-derived.
+!
+
+implicit none
+
+type :: ty1
+  integer :: ival
+  real    :: rval
+end type
+
+type :: ty2
+  type(ty1)               :: bt
+  type(ty1), allocatable  :: bt_alloc
+  type(ty1), pointer      :: bt_ptr
+  class(ty1), allocatable :: class_alloc
+  class(ty1), pointer     :: class_ptr
+end type
+
+type(ty2) basic
+class(ty1), allocatable :: calloc
+
+print *, basic%bt%ival
+print *, calloc%ival
+
+end
+
+! { dg-final { scan-tree-dump-times "\.ival *= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\.rval *= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\.bt_ptr *= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\.bt_alloc *= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\.class_alloc(?: *= *\{)?\._data *= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\.class_ptr(?: *= *\{)?\._data *= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "calloc(?: *= *\{)?\._data *= *0" 1 "original" } }