2016-08-15 Fritz Reese <fritzoreese@gmail.com>

	gcc/fortran/
	* lang.opt, invoke.texi: New flag -finit-derived.
	* gfortran.h (gfc_build_default_init_expr, gfc_apply_init,
	gfc_generate_initializer): New prototypes.
	* expr.c (gfc_build_default_init_expr, gfc_apply_init,
	component_initializer, gfc_generate_initializer): New functions.
	* expr.c (gfc_default_initializer): Wrap gfc_generate_initializer.
	* decl.c (build_struct): Move common code to gfc_apply_init.
	* resolve.c (can_generate_init): New function.
	* resolve.c (build_default_init_expr): Wrap gfc_build_default_init_expr.
	* resolve.c (apply_default_init, resolve_fl_variable_derived): Use
	gfc_generate_initializer.
	* trans-decl.c (gfc_generate_function_code): Use
	gfc_generate_initializer.

	gcc/testsuite/gfortran.dg/
	* init_flag_13.f90: New testcase.
	* init_flag_14.f90: Ditto.
	* init_flag_15.f03: Ditto.
	* dec_init_1.f90: Ditto.
	* dec_init_2.f90: Ditto.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@239489 138bc75d-0d04-0410-961f-82ee72b054a4

14 files changed, 623 insertions, 214 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 84bfb334168..c6d1ff38598 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2016-08-15  Fritz Reese  <fritzoreese@gmail.com>
+
+	gcc/fortran/
+	* lang.opt, invoke.texi: New flag -finit-derived.
+	* gfortran.h (gfc_build_default_init_expr, gfc_apply_init,
+	gfc_generate_initializer): New prototypes.
+	* expr.c (gfc_build_default_init_expr, gfc_apply_init,
+	component_initializer, gfc_generate_initializer): New functions.
+	* expr.c (gfc_default_initializer): Wrap gfc_generate_initializer.
+	* decl.c (build_struct): Move common code to gfc_apply_init.
+	* resolve.c (can_generate_init): New function.
+	* resolve.c (build_default_init_expr): Wrap gfc_build_default_init_expr.
+	* resolve.c (apply_default_init, resolve_fl_variable_derived): Use
+	gfc_generate_initializer.
+	* trans-decl.c (gfc_generate_function_code): Use
+	gfc_generate_initializer.
+
 2016-08-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* frontend-passes.c (create_var):  Set ts.deferred for
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 25b0df7130f..ce5ebb763ba 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1910,53 +1910,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
     }
   *as = NULL;
 
-  /* Should this ever get more complicated, combine with similar section
-     in add_init_expr_to_sym into a separate function.  */
-  if (c->ts.type == BT_CHARACTER && !c->attr.pointer && c->initializer
-      && c->ts.u.cl
-      && c->ts.u.cl->length && c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
-    {
-      int len;
-
-      gcc_assert (c->ts.u.cl && c->ts.u.cl->length);
-      gcc_assert (c->ts.u.cl->length->expr_type == EXPR_CONSTANT);
-      gcc_assert (c->ts.u.cl->length->ts.type == BT_INTEGER);
-
-      len = mpz_get_si (c->ts.u.cl->length->value.integer);
-
-      if (c->initializer->expr_type == EXPR_CONSTANT)
-	gfc_set_constant_character_len (len, c->initializer, -1);
-      else if (c->initializer
-		&& c->initializer->ts.u.cl
-		&& mpz_cmp (c->ts.u.cl->length->value.integer,
-			    c->initializer->ts.u.cl->length->value.integer))
-	{
-	  gfc_constructor *ctor;
-	  ctor = gfc_constructor_first (c->initializer->value.constructor);
-
-	  if (ctor)
-	    {
-	      int first_len;
-	      bool has_ts = (c->initializer->ts.u.cl
-			     && c->initializer->ts.u.cl->length_from_typespec);
-
-	      /* Remember the length of the first element for checking
-		 that all elements *in the constructor* have the same
-		 length.  This need not be the length of the LHS!  */
-	      gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT);
-	      gcc_assert (ctor->expr->ts.type == BT_CHARACTER);
-	      first_len = ctor->expr->value.character.length;
-
-	      for ( ; ctor; ctor = gfc_constructor_next (ctor))
-		if (ctor->expr->expr_type == EXPR_CONSTANT)
-		{
-		  gfc_set_constant_character_len (len, ctor->expr,
-						  has_ts ? -1 : first_len);
-		  ctor->expr->ts.u.cl->length = gfc_copy_expr (c->ts.u.cl->length);
-		}
-	    }
-	}
-    }
+  gfc_apply_init (&c->ts, &c->attr, c->initializer);
 
   /* Check array components.  */
   if (!c->attr.dimension)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6d0eb22eea5..8e2b892fc24 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3918,6 +3918,212 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
 }
 
 
+/* Build an initializer for a local integer, real, complex, logical, or
+   character variable, based on the command line flags finit-local-zero,
+   finit-integer=, finit-real=, finit-logical=, and finit-character=.  */
+
+gfc_expr *
+gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
+{
+  int char_len;
+  gfc_expr *init_expr;
+  int i;
+
+  /* Try to build an initializer expression.  */
+  init_expr = gfc_get_constant_expr (ts->type, ts->kind, where);
+
+  /* We will only initialize integers, reals, complex, logicals, and
+     characters, and only if the corresponding command-line flags
+     were set.  Otherwise, we free init_expr and return null.  */
+  switch (ts->type)
+    {
+    case BT_INTEGER:
+      if (gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF)
+        mpz_set_si (init_expr->value.integer,
+                         gfc_option.flag_init_integer_value);
+      else
+        {
+          gfc_free_expr (init_expr);
+          init_expr = NULL;
+        }
+      break;
+
+    case BT_REAL:
+      switch (flag_init_real)
+        {
+        case GFC_INIT_REAL_SNAN:
+          init_expr->is_snan = 1;
+          /* Fall through.  */
+        case GFC_INIT_REAL_NAN:
+          mpfr_set_nan (init_expr->value.real);
+          break;
+
+        case GFC_INIT_REAL_INF:
+          mpfr_set_inf (init_expr->value.real, 1);
+          break;
+
+        case GFC_INIT_REAL_NEG_INF:
+          mpfr_set_inf (init_expr->value.real, -1);
+          break;
+
+        case GFC_INIT_REAL_ZERO:
+          mpfr_set_ui (init_expr->value.real, 0.0, GFC_RND_MODE);
+          break;
+
+        default:
+          gfc_free_expr (init_expr);
+          init_expr = NULL;
+          break;
+        }
+      break;
+
+    case BT_COMPLEX:
+      switch (flag_init_real)
+        {
+        case GFC_INIT_REAL_SNAN:
+          init_expr->is_snan = 1;
+          /* Fall through.  */
+        case GFC_INIT_REAL_NAN:
+          mpfr_set_nan (mpc_realref (init_expr->value.complex));
+          mpfr_set_nan (mpc_imagref (init_expr->value.complex));
+          break;
+
+        case GFC_INIT_REAL_INF:
+          mpfr_set_inf (mpc_realref (init_expr->value.complex), 1);
+          mpfr_set_inf (mpc_imagref (init_expr->value.complex), 1);
+          break;
+
+        case GFC_INIT_REAL_NEG_INF:
+          mpfr_set_inf (mpc_realref (init_expr->value.complex), -1);
+          mpfr_set_inf (mpc_imagref (init_expr->value.complex), -1);
+          break;
+
+        case GFC_INIT_REAL_ZERO:
+          mpc_set_ui (init_expr->value.complex, 0, GFC_MPC_RND_MODE);
+          break;
+
+        default:
+          gfc_free_expr (init_expr);
+          init_expr = NULL;
+          break;
+        }
+      break;
+
+    case BT_LOGICAL:
+      if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE)
+        init_expr->value.logical = 0;
+      else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE)
+        init_expr->value.logical = 1;
+      else
+        {
+          gfc_free_expr (init_expr);
+          init_expr = NULL;
+        }
+      break;
+
+    case BT_CHARACTER:
+      /* For characters, the length must be constant in order to
+         create a default initializer.  */
+      if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
+          && ts->u.cl->length
+          && ts->u.cl->length->expr_type == EXPR_CONSTANT)
+        {
+          char_len = mpz_get_si (ts->u.cl->length->value.integer);
+          init_expr->value.character.length = char_len;
+          init_expr->value.character.string = gfc_get_wide_string (char_len+1);
+          for (i = 0; i < char_len; i++)
+            init_expr->value.character.string[i]
+              = (unsigned char) gfc_option.flag_init_character_value;
+        }
+      else
+        {
+          gfc_free_expr (init_expr);
+          init_expr = NULL;
+        }
+      if (!init_expr && gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
+          && ts->u.cl->length && flag_max_stack_var_size != 0)
+        {
+          gfc_actual_arglist *arg;
+          init_expr = gfc_get_expr ();
+          init_expr->where = *where;
+          init_expr->ts = *ts;
+          init_expr->expr_type = EXPR_FUNCTION;
+          init_expr->value.function.isym =
+                gfc_intrinsic_function_by_id (GFC_ISYM_REPEAT);
+          init_expr->value.function.name = "repeat";
+          arg = gfc_get_actual_arglist ();
+          arg->expr = gfc_get_character_expr (ts->kind, where, NULL, 1);
+          arg->expr->value.character.string[0] =
+            gfc_option.flag_init_character_value;
+          arg->next = gfc_get_actual_arglist ();
+          arg->next->expr = gfc_copy_expr (ts->u.cl->length);
+          init_expr->value.function.actual = arg;
+        }
+      break;
+
+    default:
+     gfc_free_expr (init_expr);
+     init_expr = NULL;
+    }
+
+  return init_expr;
+}
+
+/* Apply an initialization expression to a typespec. Can be used for symbols or
+   components. Similar to add_init_expr_to_sym in decl.c; could probably be
+   combined with some effort.  */
+
+void
+gfc_apply_init (gfc_typespec *ts, symbol_attribute *attr, gfc_expr *init)
+{
+  if (ts->type == BT_CHARACTER && !attr->pointer && init
+      && ts->u.cl
+      && ts->u.cl->length && ts->u.cl->length->expr_type == EXPR_CONSTANT)
+    {
+      int len;
+
+      gcc_assert (ts->u.cl && ts->u.cl->length);
+      gcc_assert (ts->u.cl->length->expr_type == EXPR_CONSTANT);
+      gcc_assert (ts->u.cl->length->ts.type == BT_INTEGER);
+
+      len = mpz_get_si (ts->u.cl->length->value.integer);
+
+      if (init->expr_type == EXPR_CONSTANT)
+        gfc_set_constant_character_len (len, init, -1);
+      else if (init
+               && init->ts.u.cl
+               && mpz_cmp (ts->u.cl->length->value.integer,
+                           init->ts.u.cl->length->value.integer))
+        {
+          gfc_constructor *ctor;
+          ctor = gfc_constructor_first (init->value.constructor);
+
+          if (ctor)
+            {
+              int first_len;
+              bool has_ts = (init->ts.u.cl
+                             && init->ts.u.cl->length_from_typespec);
+
+              /* Remember the length of the first element for checking
+                 that all elements *in the constructor* have the same
+                 length.  This need not be the length of the LHS!  */
+              gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT);
+              gcc_assert (ctor->expr->ts.type == BT_CHARACTER);
+              first_len = ctor->expr->value.character.length;
+
+              for ( ; ctor; ctor = gfc_constructor_next (ctor))
+                if (ctor->expr->expr_type == EXPR_CONSTANT)
+                {
+                  gfc_set_constant_character_len (len, ctor->expr,
+                                                  has_ts ? -1 : first_len);
+                  ctor->expr->ts.u.cl->length = gfc_copy_expr (ts->u.cl->length);
+                }
+            }
+        }
+    }
+}
+
+
 /* Check for default initializer; sym->value is not enough
    as it is also set for EXPR_NULL of allocatables.  */
 
@@ -3946,21 +4152,66 @@ gfc_has_default_initializer (gfc_symbol *der)
 }
 
 
-/* Get an expression for a default initializer.  */
+/* 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)
+{
+  gfc_expr *init = NULL;
+
+  /* See if we can find the initializer immediately.  */
+  if (c->initializer || !generate
+      || (ts->type == BT_CLASS && !c->attr.allocatable))
+    return c->initializer;
+
+  /* Recursively handle derived type components.  */
+  if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+    init = gfc_generate_initializer (&c->ts, true);
+
+  /* Treat simple components like locals.  */
+  else
+    {
+      init = gfc_build_default_init_expr (&c->ts, &c->loc);
+      gfc_apply_init (&c->ts, &c->attr, init);
+    }
+
+  return init;
+}
+
+
+/* Get an expression for a default initializer of a derived type.  */
 
 gfc_expr *
 gfc_default_initializer (gfc_typespec *ts)
 {
-  gfc_expr *init;
+  return gfc_generate_initializer (ts, false);
+}
+
+
+/* Get or generate an expression for a default initializer of a derived type. 
+   If -finit-derived is specified, generate default initialization expressions
+   for components that lack them when generate is set.  */
+
+gfc_expr *
+gfc_generate_initializer (gfc_typespec *ts, bool generate)
+{
+  gfc_expr *init, *tmp;
   gfc_component *comp;
+  generate = flag_init_derived && generate;
 
   /* See if we have a default initializer in this, but not in nested
-     types (otherwise we could use gfc_has_default_initializer()).  */
-  for (comp = ts->u.derived->components; comp; comp = comp->next)
-    if (comp->initializer || comp->attr.allocatable
-	|| (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
-	    && CLASS_DATA (comp)->attr.allocatable))
-      break;
+     types (otherwise we could use gfc_has_default_initializer()).
+     We don't need to check if we are going to generate them.  */
+  comp = ts->u.derived->components;
+  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))
+          break;
+    }
 
   if (!comp)
     return NULL;
@@ -3973,15 +4224,19 @@ gfc_default_initializer (gfc_typespec *ts)
     {
       gfc_constructor *ctor = gfc_constructor_get();
 
-      if (comp->initializer)
+      /* Fetch or generate an initializer for the component.  */
+      tmp = component_initializer (ts, comp, generate);
+      if (tmp)
 	{
 	  /* Save the component ref for STRUCTUREs and UNIONs.  */
 	  if (ts->u.derived->attr.flavor == FL_STRUCT
 	      || ts->u.derived->attr.flavor == FL_UNION)
 	    ctor->n.component = comp;
-	  ctor->expr = gfc_copy_expr (comp->initializer);
-	  if ((comp->ts.type != comp->initializer->ts.type
-	       || comp->ts.kind != comp->initializer->ts.kind)
+
+          /* 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)
 	      && !comp->attr.pointer && !comp->attr.proc_pointer)
 	    gfc_convert_type_warn (ctor->expr, &comp->ts, 2, false);
 	}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 77831ab31e9..813f7d9f10a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3041,8 +3041,11 @@ bool gfc_check_assign (gfc_expr *, gfc_expr *, int);
 bool gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
 bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
 
+gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *);
+void gfc_apply_init (gfc_typespec *, symbol_attribute *, gfc_expr *);
 bool gfc_has_default_initializer (gfc_symbol *);
 gfc_expr *gfc_default_initializer (gfc_typespec *);
+gfc_expr *gfc_generate_initializer (gfc_typespec *, bool);
 gfc_expr *gfc_get_variable_expr (gfc_symtree *);
 void gfc_add_full_array_ref (gfc_expr *, gfc_array_spec *);
 gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 2fd12cb6a1a..15c131ac865 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -178,6 +178,7 @@ and warnings}.
 -fcoarray=@var{<none|single|lib>} -fexternal-blas -ff2c
 -ffrontend-optimize @gol
 -finit-character=@var{n} -finit-integer=@var{n} -finit-local-zero @gol
+-finit-derived @gol
 -finit-logical=@var{<true|false>}
 -finit-real=@var{<zero|inf|-inf|nan|snan>} @gol
 -finline-matmul-limit=@var{n} @gol
@@ -1610,11 +1611,13 @@ on the stack. This flag cannot be used together with
 @option{-fmax-stack-var-size=} or @option{-fno-automatic}.
 
 @item -finit-local-zero
+@itemx -finit-derived
 @itemx -finit-integer=@var{n}
 @itemx -finit-real=@var{<zero|inf|-inf|nan|snan>}
 @itemx -finit-logical=@var{<true|false>}
 @itemx -finit-character=@var{n}
 @opindex @code{finit-local-zero}
+@opindex @code{finit-derived}
 @opindex @code{finit-integer}
 @opindex @code{finit-real}
 @opindex @code{finit-logical}
@@ -1629,13 +1632,13 @@ initialization options are provided by the
 the real and imaginary parts of local @code{COMPLEX} variables),
 @option{-finit-logical=@var{<true|false>}}, and
 @option{-finit-character=@var{n}} (where @var{n} is an ASCII character
-value) options.  These options do not initialize
+value) options.  Components of derived type variables will be initialized
+according to these flags only with @option{-finit-derived}.  These options do
+not initialize
 @itemize @bullet
 @item
 allocatable arrays
 @item
-components of derived type variables
-@item
 variables that appear in an @code{EQUIVALENCE} statement.
 @end itemize
 (These limitations may be removed in future releases).
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 4ff54e2ca8b..8ec5400ec95 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -528,6 +528,10 @@ finit-character=
 Fortran RejectNegative Joined UInteger
 -finit-character=<n>	Initialize local character variables to ASCII value n.
 
+finit-derived
+Fortran Var(flag_init_derived)
+Initialize components of derived type variables according to other init flags.
+
 finit-integer=
 Fortran RejectNegative Joined
 -finit-integer=<n>	Initialize local integer variables to n.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d8cfdd275b6..7763f9c7345 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11138,6 +11138,39 @@ build_init_assign (gfc_symbol *sym, gfc_expr *init)
   init_st->expr2 = init;
 }
 
+
+/* Whether or not we can generate a default initializer for a symbol.  */
+
+static bool
+can_generate_init (gfc_symbol *sym)
+{
+  symbol_attribute *a;
+  if (!sym)
+    return false;
+  a = &sym->attr;
+
+  /* These symbols should never have a default initialization.  */
+  return !(
+       a->allocatable
+    || a->external
+    || a->pointer
+    || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+        && (CLASS_DATA (sym)->attr.class_pointer
+            || CLASS_DATA (sym)->attr.proc_pointer))
+    || a->in_equivalence
+    || a->in_common
+    || a->data
+    || sym->module
+    || a->cray_pointee
+    || a->cray_pointer
+    || sym->assoc
+    || (!a->referenced && !a->result)
+    || (a->dummy && a->intent != INTENT_OUT)
+    || (a->function && sym != sym->result)
+  );
+}
+
+
 /* Assign the default initializer to a derived type variable or result.  */
 
 static void
@@ -11149,7 +11182,7 @@ apply_default_init (gfc_symbol *sym)
     return;
 
   if (sym->ts.type == BT_DERIVED && sym->ts.u.derived)
-    init = gfc_default_initializer (&sym->ts);
+    init = gfc_generate_initializer (&sym->ts, can_generate_init (sym));
 
   if (init == NULL && sym->ts.type != BT_CLASS)
     return;
@@ -11158,17 +11191,13 @@ apply_default_init (gfc_symbol *sym)
   sym->attr.referenced = 1;
 }
 
-/* Build an initializer for a local integer, real, complex, logical, or
-   character variable, based on the command line flags finit-local-zero,
-   finit-integer=, finit-real=, finit-logical=, and finit-runtime.  Returns
-   null if the symbol should not have a default initialization.  */
+
+/* Build an initializer for a local. Returns null if the symbol should not have
+   a default initialization.  */
+
 static gfc_expr *
 build_default_init_expr (gfc_symbol *sym)
 {
-  int char_len;
-  gfc_expr *init_expr;
-  int i;
-
   /* These symbols should never have a default initialization.  */
   if (sym->attr.allocatable
       || sym->attr.external
@@ -11183,145 +11212,8 @@ build_default_init_expr (gfc_symbol *sym)
       || sym->assoc)
     return NULL;
 
-  /* Now we'll try to build an initializer expression.  */
-  init_expr = gfc_get_constant_expr (sym->ts.type, sym->ts.kind,
-				     &sym->declared_at);
-
-  /* We will only initialize integers, reals, complex, logicals, and
-     characters, and only if the corresponding command-line flags
-     were set.  Otherwise, we free init_expr and return null.  */
-  switch (sym->ts.type)
-    {
-    case BT_INTEGER:
-      if (gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF)
-	mpz_set_si (init_expr->value.integer,
-			 gfc_option.flag_init_integer_value);
-      else
-	{
-	  gfc_free_expr (init_expr);
-	  init_expr = NULL;
-	}
-      break;
-
-    case BT_REAL:
-      switch (flag_init_real)
-	{
-	case GFC_INIT_REAL_SNAN:
-	  init_expr->is_snan = 1;
-	  /* Fall through.  */
-	case GFC_INIT_REAL_NAN:
-	  mpfr_set_nan (init_expr->value.real);
-	  break;
-
-	case GFC_INIT_REAL_INF:
-	  mpfr_set_inf (init_expr->value.real, 1);
-	  break;
-
-	case GFC_INIT_REAL_NEG_INF:
-	  mpfr_set_inf (init_expr->value.real, -1);
-	  break;
-
-	case GFC_INIT_REAL_ZERO:
-	  mpfr_set_ui (init_expr->value.real, 0.0, GFC_RND_MODE);
-	  break;
-
-	default:
-	  gfc_free_expr (init_expr);
-	  init_expr = NULL;
-	  break;
-	}
-      break;
-
-    case BT_COMPLEX:
-      switch (flag_init_real)
-	{
-	case GFC_INIT_REAL_SNAN:
-	  init_expr->is_snan = 1;
-	  /* Fall through.  */
-	case GFC_INIT_REAL_NAN:
-	  mpfr_set_nan (mpc_realref (init_expr->value.complex));
-	  mpfr_set_nan (mpc_imagref (init_expr->value.complex));
-	  break;
-
-	case GFC_INIT_REAL_INF:
-	  mpfr_set_inf (mpc_realref (init_expr->value.complex), 1);
-	  mpfr_set_inf (mpc_imagref (init_expr->value.complex), 1);
-	  break;
-
-	case GFC_INIT_REAL_NEG_INF:
-	  mpfr_set_inf (mpc_realref (init_expr->value.complex), -1);
-	  mpfr_set_inf (mpc_imagref (init_expr->value.complex), -1);
-	  break;
-
-	case GFC_INIT_REAL_ZERO:
-	  mpc_set_ui (init_expr->value.complex, 0, GFC_MPC_RND_MODE);
-	  break;
-
-	default:
-	  gfc_free_expr (init_expr);
-	  init_expr = NULL;
-	  break;
-	}
-      break;
-
-    case BT_LOGICAL:
-      if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE)
-	init_expr->value.logical = 0;
-      else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE)
-	init_expr->value.logical = 1;
-      else
-	{
-	  gfc_free_expr (init_expr);
-	  init_expr = NULL;
-	}
-      break;
-
-    case BT_CHARACTER:
-      /* For characters, the length must be constant in order to
-	 create a default initializer.  */
-      if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
-	  && sym->ts.u.cl->length
-	  && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
-	{
-	  char_len = mpz_get_si (sym->ts.u.cl->length->value.integer);
-	  init_expr->value.character.length = char_len;
-	  init_expr->value.character.string = gfc_get_wide_string (char_len+1);
-	  for (i = 0; i < char_len; i++)
-	    init_expr->value.character.string[i]
-	      = (unsigned char) gfc_option.flag_init_character_value;
-	}
-      else
-	{
-	  gfc_free_expr (init_expr);
-	  init_expr = NULL;
-	}
-      if (!init_expr && gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
-	  && sym->ts.u.cl->length && flag_max_stack_var_size != 0)
-	{
-	  gfc_actual_arglist *arg;
-	  init_expr = gfc_get_expr ();
-	  init_expr->where = sym->declared_at;
-	  init_expr->ts = sym->ts;
-	  init_expr->expr_type = EXPR_FUNCTION;
-	  init_expr->value.function.isym =
-		gfc_intrinsic_function_by_id (GFC_ISYM_REPEAT);
-	  init_expr->value.function.name = "repeat";
-	  arg = gfc_get_actual_arglist ();
-	  arg->expr = gfc_get_character_expr (sym->ts.kind, &sym->declared_at,
-					      NULL, 1);
-	  arg->expr->value.character.string[0]
-		= gfc_option.flag_init_character_value;
-	  arg->next = gfc_get_actual_arglist ();
-	  arg->next->expr = gfc_copy_expr (sym->ts.u.cl->length);
-	  init_expr->value.function.actual = arg;
-	}
-      break;
-
-    default:
-     gfc_free_expr (init_expr);
-     init_expr = NULL;
-    }
-  return init_expr;
+  /* Get the appropriate init expression.  */
+  return gfc_build_default_init_expr (&sym->ts, &sym->declared_at);
 }
 
 /* Add an initialization expression to a local variable.  */
@@ -11504,9 +11396,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
   /* Assign default initializer.  */
   if (!(sym->value || sym->attr.pointer || sym->attr.allocatable)
       && (!no_init_flag || sym->attr.intent == INTENT_OUT))
-    {
-      sym->value = gfc_default_initializer (&sym->ts);
-    }
+    sym->value = gfc_generate_initializer (&sym->ts, can_generate_init (sym));
 
   return true;
 }
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 25b846e7b85..6cf7f573bf6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -6256,7 +6256,8 @@ gfc_generate_function_code (gfc_namespace * ns)
 	      /* Arrays are not initialized using the default initializer of
 		 their elements.  Therefore only check if a default
 		 initializer is available when the result is scalar.  */
-	      init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->ts);
+              init_exp = rsym->as ? NULL
+                                  : gfc_generate_initializer (&rsym->ts, true);
 	      if (init_exp)
 		{
 		  tmp = gfc_trans_structure_assign (result, init_exp, 0);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4b4c9ca2a1c..810aca1a4a8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2016-08-15  Fritz Reese  <fritzoreese@gmail.com>
+
+	* gfortran.dg/init_flag_13.f90: New testcase.
+	* gfortran.dg/init_flag_14.f90: Ditto.
+	* gfortran.dg/init_flag_15.f03: Ditto.
+	* gfortran.dg/dec_init_1.f90: Ditto.
+	* gfortran.dg/dec_init_2.f90: Ditto.
+
 2016-08-15  Uros Bizjak  <ubizjak@gmail.com>
 
 	PR target/72867
diff --git a/gcc/testsuite/gfortran.dg/dec_init_1.f90 b/gcc/testsuite/gfortran.dg/dec_init_1.f90
new file mode 100644
index 00000000000..91f16f85294
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_init_1.f90
@@ -0,0 +1,62 @@
+! { dg-do run }
+! { dg-options "-fdec-structure -finit-derived -finit-local-zero -fdump-tree-original" }
+!
+! Test -finit-derived with DEC structure and union.
+!
+
+subroutine dummy(i1,r1,c1,l1,i2,r2,c2,l2)
+  implicit none
+  integer, intent(in) :: i1
+  real, intent(in) :: r1
+  character, intent(in) :: c1
+  logical, intent(in) :: l1
+  integer, intent(inout) :: i2
+  real, intent(inout) :: r2
+  character, intent(inout) :: c2
+  logical, intent(inout) :: l2
+  print *, i1, i2, l1, l2, c1, c2, r1, r2
+  if ( i1 .ne. 0 .or. i2 .ne. 0 ) call abort()
+  if ( l1 .or. l2 ) call abort()
+  if ( c1 .ne. achar(0) .or. c2 .ne. achar(0) ) call abort()
+  if ( r1 .ne. 0.0 .or. r2 .ne. 0.0 ) call abort()
+end subroutine
+
+structure /s3/
+  union
+    map
+      integer m11
+      real m12
+      character m13
+      logical m14
+    end map
+    map
+      logical m21
+      character m22
+      real m23
+      integer m24
+    end map
+  end union
+end structure
+
+structure /s2/
+  integer i2
+  real r2
+  character c2
+  logical l2
+end structure
+
+structure /s1/
+  logical l1
+  real r1
+  character c1
+  integer i1
+  record /s2/ y
+end structure
+
+record /s1/ x
+record /s3/ y
+
+call dummy (x.i1, x.r1, x.c1, x.l1, x.y.i2, x.y.r2, x.y.c2, x.y.l2)
+call dummy (y.m11, y.m12, y.m13, y.m14, y.m24, y.m23, y.m22, y.m21)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_init_2.f90 b/gcc/testsuite/gfortran.dg/dec_init_2.f90
new file mode 100644
index 00000000000..0efcdf96ad1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_init_2.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-fdec-structure -finit-derived -finit-integer=42 -finit-real=nan -finit-logical=true -finit-character=32 -fdump-tree-original" }
+!
+! Test -finit-derived with DEC structure and union.
+!
+
+subroutine dummy(i1,r1,c1,l1,i2,r2,c2,l2)
+  implicit none
+  integer, intent(in) :: i1
+  real, intent(in) :: r1
+  character, intent(in) :: c1
+  logical, intent(in) :: l1
+  integer, intent(inout) :: i2
+  real, intent(inout) :: r2
+  character, intent(inout) :: c2
+  logical, intent(inout) :: l2
+  print *, i1, i2, l1, l2, c1, c2, r1, r2
+  if ( i1 .ne. 42 .or. i2 .ne. 42 ) call abort()
+  if ( (.not. l1) .or. (.not. l2) ) call abort()
+  if ( c1 .ne. achar(32) .or. c2 .ne. achar(32) ) call abort()
+  if ( (.not. isnan(r1)) .or. (.not. isnan(r2)) ) call abort()
+end subroutine
+
+! Nb. the current implementation decides the -finit-* flags are meaningless
+! with components of a union, so we omit the union test here.
+
+structure /s2/
+  integer i2
+  real r2
+  character c2
+  logical l2
+end structure
+
+structure /s1/
+  logical l1
+  real r1
+  character c1
+  integer i1
+  record /s2/ y
+end structure
+
+record /s1/ x
+
+call dummy (x.i1, x.r1, x.c1, x.l1, x.y.i2, x.y.r2, x.y.c2, x.y.l2)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/init_flag_13.f90 b/gcc/testsuite/gfortran.dg/init_flag_13.f90
new file mode 100644
index 00000000000..cdd039af78c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_13.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-finit-local-zero -finit-derived -fdump-tree-original" }
+!
+! Make sure -finit-derived initializes components of local derived type
+! variables to zero with -finit-local-zero.
+!
+
+subroutine dummy(i1,r1,c1,l1,i2,r2,c2,l2)
+  implicit none
+  integer, intent(in) :: i1
+  real, intent(in) :: r1
+  character, intent(in) :: c1
+  logical, intent(in) :: l1
+  integer, intent(out) :: i2
+  real, intent(out) :: r2
+  character, intent(out) :: c2
+  logical, intent(out) :: l2
+end subroutine
+
+type t2
+  integer i2
+  real r2
+  character c2
+  logical l2
+end type
+
+type t1
+  logical l1
+  real r1
+  character c1
+  integer i1
+  type (t2) y
+end type
+
+type (t1) :: x
+
+call dummy (x%i1, x%r1, x%c1, x%l1, x%y%i2, x%y%r2, x%y%c2, x%y%l2)
+
+end
+
+! We expect to see each component initialized exactly once in MAIN.
+! NB. the "once" qualifier also tests that the dummy variables aren't
+! given an extraneous initializer.
+! { dg-final { scan-tree-dump-times "i1= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "r1= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c1= *\"\"" 1 "original" } }
+! { dg-final { scan-tree-dump-times "l1= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "i2= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "r2= *0" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c2= *\"\"" 1 "original" } }
+! { dg-final { scan-tree-dump-times "l2= *0" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/init_flag_14.f90 b/gcc/testsuite/gfortran.dg/init_flag_14.f90
new file mode 100644
index 00000000000..13991f826d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_14.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-finit-derived -finit-integer=42 -finit-real=inf -finit-logical=true -finit-character=32 -fdump-tree-original" }
+!
+! Make sure -finit-derived initializes components of local derived type
+! variables according to other -finit-* flags.
+!
+
+subroutine dummy(i1,r1,c1,l1,i2,r2,c2,l2)
+  implicit none
+  integer, intent(in) :: i1
+  real, intent(in) :: r1
+  character, intent(in) :: c1
+  logical, intent(in) :: l1
+  integer, intent(out) :: i2
+  real, intent(out) :: r2
+  character, intent(out) :: c2
+  logical, intent(out) :: l2
+end subroutine
+
+type t2
+  integer i2
+  real r2
+  character c2
+  logical l2
+end type
+
+type t1
+  logical l1
+  real r1
+  character c1
+  integer i1
+  type (t2) y
+end type
+
+type (t1) :: x
+
+call dummy (x%i1, x%r1, x%c1, x%l1, x%y%i2, x%y%r2, x%y%c2, x%y%l2)
+
+end
+
+! We expect to see each component initialized exactly once in MAIN.
+! NB. the "once" qualifier also tests that the dummy variables aren't
+! given an extraneous initializer.
+! { dg-final { scan-tree-dump-times "i1= *42" 1 "original" } }
+! { dg-final { scan-tree-dump-times "r1= *\[iI]nf" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c1= *\" \"" 1 "original" } }
+! { dg-final { scan-tree-dump-times "l1= *1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "i2= *42" 1 "original" } }
+! { dg-final { scan-tree-dump-times "r2= *\[iI]nf" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c2= *\" \"" 1 "original" } }
+! { dg-final { scan-tree-dump-times "l2= *1" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/init_flag_15.f03 b/gcc/testsuite/gfortran.dg/init_flag_15.f03
new file mode 100644
index 00000000000..fef9442dd50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_15.f03
@@ -0,0 +1,64 @@
+! { dg-do run }
+! { dg-options "-finit-derived -finit-integer=1" }
+!
+! Make sure -finit-derived works on class variables.
+! Based on class_result_1.f03
+!
+
+module points_2i
+
+  implicit none
+
+  type point2i
+      integer :: x, y
+  end type
+
+contains
+
+ subroutine print( point )
+   class(point2i) :: point
+   write(*,'(2i4)') point%x, point%y
+ end subroutine
+
+ subroutine set_vector( point, rx, ry )
+   class(point2i) :: point
+   integer :: rx, ry
+   point%x = rx
+   point%y = ry
+ end subroutine
+
+ function add_vector( point, vector )
+   class(point2i), intent(in)  :: point, vector
+   class(point2i), allocatable :: add_vector
+   allocate( add_vector )
+   add_vector%x = point%x + vector%x
+   add_vector%y = point%y + vector%y
+ end function
+
+end module
+
+
+program init_flag_15
+
+  use points_2i
+  implicit none
+
+  type(point2i), target   :: point_2i, vector_2i
+  class(point2i), pointer :: point, vector
+  type(point2i) :: vsum
+  integer :: i
+
+  point  => point_2i ! = (1, 1) due to -finit-integer
+  vector => vector_2i
+  call set_vector(vector, 2, 2)
+  vsum = add_vector(point, vector)
+
+  call print(point)
+  call print(vector)
+  call print(vsum)
+
+  if (vsum%x .ne. 3 .or. vsum%y .ne. 3) then
+    call abort()
+  endif
+
+end program