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

1 files changed, 48 insertions, 25 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 951bdce..c5bf822 100644
--- 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);
     }