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

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

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);
     }
 

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.

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

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" } }