From e70f3917a7b2d35f9baad2f09199c1ccc60a04d4 Mon Sep 17 00:00:00 2001
From: Fritz Reese <fritzoreese@gmail.com>
Date: Fri, 10 Nov 2017 16:10:06 -0500
Subject: [PATCH] Fix -finit-derived when given without other -finit-* flags.

	PR fortran/82886
	gcc/fortran/
	* gfortran.h (gfc_build_init_expr): New prototype.
	* invoke.texi (finit-derived): Update documentation.
	* expr.c (gfc_build_init_expr): New, from gfc_build_default_init_expr.
	(gfc_build_default_init_expr): Redirect to gfc_build_init_expr(,,false)
	(component_initializer): Force building initializers using
	gfc_build_init_expr(,,true).

	PR fortran/82886
	* gcc/testsuite/gfortran.dg/init_flag_16.f03: New testcase.
---
 gcc/fortran/expr.c                         | 42 ++++++++++++++++++------
 gcc/fortran/gfortran.h                     |  1 +
 gcc/fortran/invoke.texi                    | 11 +++++--
 gcc/testsuite/gfortran.dg/init_flag_16.f03 | 25 +++++++++++++++
 libiberty/functions.texi                   | 51 +++++++++++++++---------------
 5 files changed, 91 insertions(+), 39 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/init_flag_16.f03

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index bc05db2fbae..09abacf83ec 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4013,13 +4013,22 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
   return true;
 }
 
+/* Invoke gfc_build_init_expr to create an initializer expression, but do not
+ * require that an expression be built.  */
+
+gfc_expr *
+gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
+{
+  return gfc_build_init_expr (ts, where, false);
+}
 
 /* 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=.  */
+   finit-integer=, finit-real=, finit-logical=, and finit-character=.
+   With force, an initializer is ALWAYS generated.  */
 
 gfc_expr *
-gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
+gfc_build_init_expr (gfc_typespec *ts, locus *where, bool force)
 {
   int char_len;
   gfc_expr *init_expr;
@@ -4028,13 +4037,24 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
   /* Try to build an initializer expression.  */
   init_expr = gfc_get_constant_expr (ts->type, ts->kind, where);
 
+  /* If we want to force generation, make sure we default to zero.  */
+  gfc_init_local_real init_real = flag_init_real;
+  int init_logical = gfc_option.flag_init_logical;
+  if (force)
+    {
+      if (init_real == GFC_INIT_REAL_OFF)
+	init_real = GFC_INIT_REAL_ZERO;
+      if (init_logical == GFC_INIT_LOGICAL_OFF)
+	init_logical = GFC_INIT_LOGICAL_FALSE;
+    }
+
   /* 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)
+      if (force || gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF)
         mpz_set_si (init_expr->value.integer,
                          gfc_option.flag_init_integer_value);
       else
@@ -4045,7 +4065,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
       break;
 
     case BT_REAL:
-      switch (flag_init_real)
+      switch (init_real)
         {
         case GFC_INIT_REAL_SNAN:
           init_expr->is_snan = 1;
@@ -4074,7 +4094,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
       break;
 
     case BT_COMPLEX:
-      switch (flag_init_real)
+      switch (init_real)
         {
         case GFC_INIT_REAL_SNAN:
           init_expr->is_snan = 1;
@@ -4106,9 +4126,9 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
       break;
 
     case BT_LOGICAL:
-      if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE)
+      if (init_logical == GFC_INIT_LOGICAL_FALSE)
         init_expr->value.logical = 0;
-      else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE)
+      else if (init_logical == GFC_INIT_LOGICAL_TRUE)
         init_expr->value.logical = 1;
       else
         {
@@ -4120,7 +4140,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
     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
+      if ((force || gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON)
           && ts->u.cl->length
           && ts->u.cl->length->expr_type == EXPR_CONSTANT)
         {
@@ -4136,7 +4156,8 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
           gfc_free_expr (init_expr);
           init_expr = NULL;
         }
-      if (!init_expr && gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
+      if (!init_expr
+	  && (force || gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON)
           && ts->u.cl->length && flag_max_stack_var_size != 0)
         {
           gfc_actual_arglist *arg;
@@ -4391,7 +4412,8 @@ component_initializer (gfc_typespec *ts, gfc_component *c, bool generate)
   /* Treat simple components like locals.  */
   else
     {
-      init = gfc_build_default_init_expr (&c->ts, &c->loc);
+      /* We MUST give an initializer, so force generation.  */
+      init = gfc_build_init_expr (&c->ts, &c->loc, true);
       gfc_apply_init (&c->ts, &c->attr, init);
     }
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 213c5da56f7..a57676a2be1 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3174,6 +3174,7 @@ 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 *);
+gfc_expr *gfc_build_init_expr (gfc_typespec *, locus *, bool);
 void gfc_apply_init (gfc_typespec *, symbol_attribute *, gfc_expr *);
 bool gfc_has_default_initializer (gfc_symbol *);
 gfc_expr *gfc_default_initializer (gfc_typespec *);
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index bcb62434931..f3a8b34a26b 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -1714,9 +1714,14 @@ 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.  Components of derived type variables will be initialized
-according to these flags only with @option{-finit-derived}.  These options do
-not initialize
+value) options.
+
+With @option{-finit-derived}, components of derived type variables will be
+initialized according to these flags.  Components whose type is not covered by
+an explicit @option{-finit-*} flag will be treated as described above with
+@option{-finit-local-zero}.
+
+These options do not initialize
 @itemize @bullet
 @item
 objects with the POINTER attribute
diff --git a/gcc/testsuite/gfortran.dg/init_flag_16.f03 b/gcc/testsuite/gfortran.dg/init_flag_16.f03
new file mode 100644
index 00000000000..a39df63d772
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_16.f03
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-finit-derived" }
+!
+! PR fortran/82886
+!
+! Test a regression which caused an ICE when -finit-derived was given without
+! other -finit-* flags, especially for derived-type components with potentially
+! hidden basic integer components.
+!
+
+program pr82886
+
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
+  type t
+    type(c_ptr) :: my_c_ptr
+  end type
+
+contains
+
+  subroutine sub0() bind(c)
+    type(t), target :: my_f90_type
+    my_f90_type%my_c_ptr = c_null_ptr
+  end subroutine
+
+end
diff --git a/libiberty/functions.texi b/libiberty/functions.texi
index 24dcc373ac0..8779e91b0fe 100644
--- a/libiberty/functions.texi
+++ b/libiberty/functions.texi
@@ -84,7 +84,7 @@ is respectively less than, matching, or greater than the array member.
 
 @end deftypefn
 
-@c argv.c:135
+@c argv.c:138
 @deftypefn Extension char** buildargv (char *@var{sp})
 
 Given a pointer to a string, parse the string extracting fields
@@ -148,7 +148,7 @@ not recommended.
 
 @end deftypefn
 
-@c make-temp-file.c:96
+@c make-temp-file.c:95
 @deftypefn Replacement const char* choose_tmpdir ()
 
 Returns a pointer to a directory path suitable for creating temporary
@@ -175,7 +175,7 @@ Concatenate zero or more of strings and return the result in freshly
 
 @end deftypefn
 
-@c argv.c:470
+@c argv.c:485
 @deftypefn Extension int countargv (char * const *@var{argv})
 
 Return the number of elements in @var{argv}.
@@ -183,7 +183,7 @@ Returns zero if @var{argv} is NULL.
 
 @end deftypefn
 
-@c crc32.c:141
+@c crc32.c:140
 @deftypefn Extension {unsigned int} crc32 (const unsigned char *@var{buf}, @
   int @var{len}, unsigned int @var{init})
 
@@ -192,10 +192,9 @@ starting value is @var{init}; this may be used to compute the CRC of
 data split across multiple buffers by passing the return value of each
 call as the @var{init} parameter of the next.
 
-This is intended to match the CRC used by the @command{gdb} remote
-protocol for the @samp{qCRC} command.  In order to get the same
-results as gdb for a block of data, you must pass the first CRC
-parameter as @code{0xffffffff}.
+This is used by the @command{gdb} remote protocol for the @samp{qCRC}
+command.  In order to get the same results as gdb for a block of data,
+you must pass the first CRC parameter as @code{0xffffffff}.
 
 This CRC can be specified as:
 
@@ -212,7 +211,7 @@ make it easy to compose the values of multiple blocks.
 
 @end deftypefn
 
-@c argv.c:52
+@c argv.c:59
 @deftypefn Extension char** dupargv (char * const *@var{vector})
 
 Duplicate an argument vector.  Simply scans through @var{vector},
@@ -223,7 +222,7 @@ argument vector.
 
 @end deftypefn
 
-@c strerror.c:567
+@c strerror.c:572
 @deftypefn Extension int errno_max (void)
 
 Returns the maximum @code{errno} value for which a corresponding
@@ -241,7 +240,7 @@ symbolic name or message.
 
 @end deftypefn
 
-@c argv.c:341
+@c argv.c:344
 @deftypefn Extension void expandargv (int *@var{argcp}, char ***@var{argvp})
 
 The @var{argcp} and @code{argvp} arguments are pointers to the usual
@@ -410,7 +409,7 @@ unchanged.
 
 @end deftypefn
 
-@c argv.c:90
+@c argv.c:93
 @deftypefn Extension void freeargv (char **@var{vector})
 
 Free an argument vector that was built using @code{buildargv}.  Simply
@@ -431,7 +430,7 @@ unchanged.
 
 @end deftypefn
 
-@c getruntime.c:82
+@c getruntime.c:86
 @deftypefn Replacement long get_run_time (void)
 
 Returns the time used so far, in microseconds.  If possible, this is
@@ -515,7 +514,7 @@ systems.
 
 @end deftypefn
 
-@c safe-ctype.c:25
+@c safe-ctype.c:24
 @defvr Extension HOST_CHARSET
 This macro indicates the basic character set and encoding used by the
 host: more precisely, the encoding used for character constants in
@@ -537,7 +536,7 @@ nineteen EBCDIC varying characters is tested; exercise caution.)
 @end ftable
 @end defvr
 
-@c hashtab.c:328
+@c hashtab.c:327
 @deftypefn Supplemental htab_t htab_create_typed_alloc (size_t @var{size}, @
 htab_hash @var{hash_f}, htab_eq @var{eq_f}, htab_del @var{del_f}, @
 htab_alloc @var{alloc_tab_f}, htab_alloc @var{alloc_f}, @
@@ -586,7 +585,7 @@ struct qelem @{
 
 @end deftypefn
 
-@c safe-ctype.c:46
+@c safe-ctype.c:45
 @deffn  Extension ISALPHA  (@var{c})
 @deffnx Extension ISALNUM  (@var{c})
 @deffnx Extension ISBLANK  (@var{c})
@@ -636,7 +635,7 @@ false for characters with numeric values from 128 to 255.
 @end itemize
 @end deffn
 
-@c safe-ctype.c:95
+@c safe-ctype.c:94
 @deffn  Extension ISIDNUM         (@var{c})
 @deffnx Extension ISIDST          (@var{c})
 @deffnx Extension IS_VSPACE       (@var{c})
@@ -684,7 +683,7 @@ components will be simplified.  The returned value will be allocated using
 
 @end deftypefn
 
-@c make-relative-prefix.c:24
+@c make-relative-prefix.c:23
 @deftypefn Extension {const char*} make_relative_prefix (const char *@var{progname}, @
   const char *@var{bin_prefix}, const char *@var{prefix})
 
@@ -710,7 +709,7 @@ relative prefix can be found, return @code{NULL}.
 
 @end deftypefn
 
-@c make-temp-file.c:174
+@c make-temp-file.c:173
 @deftypefn Replacement char* make_temp_file (const char *@var{suffix})
 
 Return a temporary file name (as a string) or @code{NULL} if unable to
@@ -791,7 +790,7 @@ Sets the first @var{count} bytes of @var{s} to the constant byte
 
 @end deftypefn
 
-@c mkstemps.c:58
+@c mkstemps.c:60
 @deftypefn Replacement int mkstemps (char *@var{pattern}, int @var{suffix_len})
 
 Generate a unique temporary file name from @var{pattern}.
@@ -1204,7 +1203,7 @@ deprecated in new programs in favor of @code{strrchr}.
 
 @end deftypefn
 
-@c setenv.c:23
+@c setenv.c:22
 @deftypefn Supplemental int setenv (const char *@var{name}, @
   const char *@var{value}, int @var{overwrite})
 @deftypefnx Supplemental void unsetenv (const char *@var{name})
@@ -1478,7 +1477,7 @@ valid until at least the next call.
 
 @end deftypefn
 
-@c splay-tree.c:303
+@c splay-tree.c:302
 @deftypefn Supplemental splay_tree splay_tree_new_with_typed_alloc @
 (splay_tree_compare_fn @var{compare_fn}, @
 splay_tree_delete_key_fn @var{delete_key_fn}, @
@@ -1549,7 +1548,7 @@ Returns a pointer to a copy of @var{s} in memory obtained from
 
 @end deftypefn
 
-@c strerror.c:670
+@c strerror.c:675
 @deftypefn Replacement {const char*} strerrno (int @var{errnum})
 
 Given an error number returned from a system call (typically returned
@@ -1569,7 +1568,7 @@ valid until the next call to @code{strerrno}.
 
 @end deftypefn
 
-@c strerror.c:603
+@c strerror.c:608
 @deftypefn Supplemental char* strerror (int @var{errnoval})
 
 Maps an @code{errno} number to an error message string, the contents
@@ -1698,7 +1697,7 @@ the location referenced by @var{endptr}.
 
 @end deftypefn
 
-@c strerror.c:729
+@c strerror.c:734
 @deftypefn Extension int strtoerrno (const char *@var{name})
 
 Given the symbolic name of a error number (e.g., @code{EACCES}), map it
@@ -1914,7 +1913,7 @@ does the return value.  The third argument is unused in @libib{}.
 
 @end deftypefn
 
-@c argv.c:286
+@c argv.c:289
 @deftypefn Extension int writeargv (char * const *@var{argv}, FILE *@var{file})
 
 Write each member of ARGV, handling all necessary quoting, to the file
-- 
2.12.2

