PR fortran/20441

        * gfortran.h : Add init_local_* enums and init_flag_* flags to
	gfc_option_t.
	* lang.opt: Add -finit-local-zero, -finit-real, -finit-integer,
	-finit-character, and -finit-logical flags.
	* invoke.texi: Document new options.
	* resolve.c (build_init_assign): New function.
	(apply_init_assign): Move part of function into build_init_assign.
	(build_default_init_expr): Build local initializer (-finit-*).
	(apply_default_init_local): Apply local initializer (-finit-*).
	(resolve_fl_variable): Try to add local initializer (-finit-*).
	* options.c (gfc_init_options, gfc_handle_option,
	gfc_post_options): Handle -finit-local-zero, -finit-real,
	-finit-integer, -finit-character, and -finit-logical flags.

	PR fortran/20441
	* gfortran.dg/init_flag_1.f90: New.
	* gfortran.dg/init_flag_2.f90: New.
	* gfortran.dg/init_flag_3.f90: New.
	* gfortran.dg/init_flag_4.f90: New.
	* gfortran.dg/init_flag_5.f90: New.
	* gfortran.dg/init_flag_6.f90: New.
	* gfortran.dg/init_flag_7.f90: New.



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

6 files changed, 363 insertions, 16 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5a81ebe71d4..e9030900eba 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2007-09-20  Asher Langton  <langton2@llnl.gov>
+
+	PR fortran/20441
+        * gfortran.h : Add init_local_* enums and init_flag_* flags to
+	gfc_option_t.
+	* lang.opt: Add -finit-local-zero, -finit-real, -finit-integer,
+	-finit-character, and -finit-logical flags.
+	* invoke.texi: Document new options.
+	* resolve.c (build_init_assign): New function.
+	(apply_init_assign): Move part of function into build_init_assign.
+	(build_default_init_expr): Build local initializer (-finit-*).
+	(apply_default_init_local): Apply local initializer (-finit-*).
+	(resolve_fl_variable): Try to add local initializer (-finit-*).
+	* options.c (gfc_init_options, gfc_handle_option,
+	gfc_post_options): Handle -finit-local-zero, -finit-real,
+	-finit-integer, -finit-character, and -finit-logical flags.
+
 2007-09-20  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/33221
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 32b15616600..42002cee21e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -510,6 +510,38 @@ enum gfc_isym_id
 typedef enum gfc_isym_id gfc_isym_id;
 
 
+typedef enum
+{
+  GFC_INIT_REAL_OFF = 0,
+  GFC_INIT_REAL_ZERO,
+  GFC_INIT_REAL_NAN,
+  GFC_INIT_REAL_INF,
+  GFC_INIT_REAL_NEG_INF
+}
+init_local_real;
+
+typedef enum
+{
+  GFC_INIT_LOGICAL_OFF = 0,
+  GFC_INIT_LOGICAL_FALSE,
+  GFC_INIT_LOGICAL_TRUE
+}
+init_local_logical;
+
+typedef enum
+{
+  GFC_INIT_CHARACTER_OFF = 0,
+  GFC_INIT_CHARACTER_ON
+}
+init_local_character;
+
+typedef enum
+{
+  GFC_INIT_INTEGER_OFF = 0,
+  GFC_INIT_INTEGER_ON
+}
+init_local_integer;
+
 /************************* Structures *****************************/
 
 /* Used for keeping things in balanced binary trees.  */
@@ -1823,6 +1855,13 @@ typedef struct
   int flag_sign_zero;
   int flag_module_private;
   int flag_recursive;
+  int flag_init_local_zero;
+  int flag_init_integer;
+  int flag_init_integer_value;
+  int flag_init_real;
+  int flag_init_logical;
+  int flag_init_character;
+  char flag_init_character_value;
 
   int fpe;
 
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 1388b6c123e..754974fe8c7 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -156,7 +156,9 @@ and warnings}.
 -fsecond-underscore @gol
 -fbounds-check  -fmax-stack-var-size=@var{n} @gol
 -fpack-derived  -frepack-arrays  -fshort-enums  -fexternal-blas @gol
--fblas-matmul-limit=@var{n} -frecursive}
+-fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol
+-finit-integer=@var{n} -finit-real=@var{<zero|inf|-inf|nan>} @gol
+-finit-logical=@var{<true|false>} -finit-character=@var{n}}
 @end table
 
 @menu
@@ -931,6 +933,33 @@ Allow indirect recursion by forcing all local arrays to be allocated
 on the stack. This flag cannot be used together with
 @option{-fmax-stack-var-size=} or @option{-fno-automatic}.
 
+@item -finit-local-zero
+@item -finit-integer=@var{n}
+@item -finit-real=@var{<zero|inf|-inf|nan>} 
+@item -finit-logical=@var{<true|false>}
+@item -finit-character=@var{n}
+@opindex @code{finit-local-zero}
+@opindex @code{finit-integer}
+@opindex @code{finit-real}
+@opindex @code{finit-logical}
+@opindex @code{finit-character}
+The @option{-finit-local-zero} option instructs the compiler to
+initialize local @code{INTEGER}, @code{REAL}, and @code{COMPLEX}
+variables to zero, @code{LOGICAL} variables to false, and
+@code{CHARACTER} variables to a string of null bytes.  Finer-grained
+initialization options are provided by the
+@option{-finit-integer=@var{n}},
+@option{-finit-real=@var{<zero|inf|-inf|nan>}} (which also initializes
+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 components of derived
+type variables, nor do they initialize variables that appear in an
+@code{EQUIVALENCE} statement.  (This limitation may be removed in
+future releases).
+
+Note that the @option{-finit-real=nan} option initializes @code{REAL}
+and @code{COMPLEX} variables with a quiet NaN.
 @end table
 
 @xref{Code Gen Options,,Options for Code Generation Conventions,
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 558cf657aac..55e8b516028 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -196,6 +196,26 @@ fimplicit-none
 Fortran
 Specify that no implicit typing is allowed, unless overridden by explicit IMPLICIT statements
 
+finit-character=
+Fortran RejectNegative Joined UInteger
+-finit-character=<n> Initialize local character variables to ASCII value n
+
+finit-integer=
+Fortran RejectNegative Joined
+-finit-integer=<n> Initialize local integer variables to n
+
+finit-local-zero
+Fortran
+Initialize local variables to zero (from g77)
+
+finit-logical=
+Fortran RejectNegative Joined
+-finit-logical=<true|false> Initialize local logical variables
+
+finit-real=
+Fortran RejectNegative Joined
+-finit-real=<zero|nan|inf|-inf> Initialize local real variables
+
 fmax-errors=
 Fortran RejectNegative Joined UInteger
 -fmax-errors=<n>	Maximum number of errors to report
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 2d11ad7dfd6..5c3aefa4fe1 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -107,7 +107,13 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
   gfc_option.flag_openmp = 0;
   gfc_option.flag_sign_zero = 1;
   gfc_option.flag_recursive = 0;
-
+  gfc_option.flag_init_integer = GFC_INIT_INTEGER_OFF;
+  gfc_option.flag_init_integer_value = 0;
+  gfc_option.flag_init_real = GFC_INIT_REAL_OFF;
+  gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF;
+  gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF;
+  gfc_option.flag_init_character_value = (char)0;
+  
   gfc_option.fpe = 0;
 
   /* Argument pointers cannot point to anything but their argument.  */
@@ -650,6 +656,55 @@ gfc_handle_option (size_t scode, const char *arg, int value)
       gfc_option.flag_default_double = value;
       break;
 
+    case OPT_finit_local_zero:
+      gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
+      gfc_option.flag_init_integer_value = 0;
+      gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
+      gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
+      gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
+      gfc_option.flag_init_character_value = (char)0;
+      break;
+
+    case OPT_finit_logical_:
+      if (!strcasecmp (arg, "false"))
+	gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
+      else if (!strcasecmp (arg, "true"))
+	gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
+      else
+	gfc_fatal_error ("Unrecognized option to -finit-logical: %s",
+			 arg);
+      break;
+
+    case OPT_finit_real_:
+      if (!strcasecmp (arg, "zero"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
+      else if (!strcasecmp (arg, "nan"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
+      else if (!strcasecmp (arg, "inf"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_INF;
+      else if (!strcasecmp (arg, "-inf"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_NEG_INF;
+      else
+	gfc_fatal_error ("Unrecognized option to -finit-real: %s",
+			 arg);
+      break;      
+
+    case OPT_finit_integer_:
+      gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
+      gfc_option.flag_init_integer_value = atoi (arg);
+      break;
+
+    case OPT_finit_character_:
+      if (value >= 0 && value <= 127)
+	{
+	  gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
+	  gfc_option.flag_init_character_value = (char)value;
+	}
+      else
+	gfc_fatal_error ("The value of n in -finit-character=n must be "
+			 "between 0 and 127");
+      break;
+
     case OPT_I:
       gfc_add_include_path (arg, true);
       break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 26632bbde84..2f578e736d5 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6605,26 +6605,15 @@ is_non_constant_shape_array (gfc_symbol *sym)
   return not_constant;
 }
 
-
-/* Assign the default initializer to a derived type variable or result.  */
-
+/* Given a symbol and an initialization expression, add code to initialize
+   the symbol to the function entry.  */
 static void
-apply_default_init (gfc_symbol *sym)
+build_init_assign (gfc_symbol *sym, gfc_expr *init)
 {
   gfc_expr *lval;
-  gfc_expr *init = NULL;
   gfc_code *init_st;
   gfc_namespace *ns = sym->ns;
 
-  if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
-    return;
-
-  if (sym->ts.type == BT_DERIVED && sym->ts.derived)
-    init = gfc_default_initializer (&sym->ts);
-
-  if (init == NULL)
-    return;
-
   /* Search for the function namespace if this is a contained
      function without an explicit result.  */
   if (sym->attr.function && sym == sym->result
@@ -6657,6 +6646,201 @@ apply_default_init (gfc_symbol *sym)
   init_st->expr2 = init;
 }
 
+/* Assign the default initializer to a derived type variable or result.  */
+
+static void
+apply_default_init (gfc_symbol *sym)
+{
+  gfc_expr *init = NULL;
+
+  if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
+    return;
+
+  if (sym->ts.type == BT_DERIVED && sym->ts.derived)
+    init = gfc_default_initializer (&sym->ts);
+
+  if (init == NULL)
+    return;
+
+  build_init_assign (sym, init);
+}
+
+/* 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.  */
+static gfc_expr *
+build_default_init_expr (gfc_symbol *sym)
+{
+  int char_len;
+  gfc_expr *init_expr;
+  int i;
+  char *ch;
+
+  /* These symbols should never have a default initialization.  */
+  if ((sym->attr.dimension && !gfc_is_compile_time_shape (sym->as))
+      || sym->attr.external
+      || sym->attr.dummy
+      || sym->attr.pointer
+      || sym->attr.in_equivalence
+      || sym->attr.in_common
+      || sym->attr.data
+      || sym->module
+      || sym->attr.cray_pointee
+      || sym->attr.cray_pointer)
+    return NULL;
+
+  /* Now we'll try to build an initializer expression.  */
+  init_expr = gfc_get_expr ();
+  init_expr->expr_type = EXPR_CONSTANT;
+  init_expr->ts.type = sym->ts.type;
+  init_expr->ts.kind = sym->ts.kind;
+  init_expr->where = 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_init_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:
+      mpfr_init (init_expr->value.real);
+      switch (gfc_option.flag_init_real)
+	{
+	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:
+      mpfr_init (init_expr->value.complex.r);
+      mpfr_init (init_expr->value.complex.i);
+      switch (gfc_option.flag_init_real)
+	{
+	case GFC_INIT_REAL_NAN:
+	  mpfr_set_nan (init_expr->value.complex.r);
+	  mpfr_set_nan (init_expr->value.complex.i);
+	  break;
+
+	case GFC_INIT_REAL_INF:
+	  mpfr_set_inf (init_expr->value.complex.r, 1);
+	  mpfr_set_inf (init_expr->value.complex.i, 1);
+	  break;
+
+	case GFC_INIT_REAL_NEG_INF:
+	  mpfr_set_inf (init_expr->value.complex.r, -1);
+	  mpfr_set_inf (init_expr->value.complex.i, -1);
+	  break;
+
+	case GFC_INIT_REAL_ZERO:
+	  mpfr_set_ui (init_expr->value.complex.r, 0.0, GFC_RND_MODE);
+	  mpfr_set_ui (init_expr->value.complex.i, 0.0, GFC_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.cl->length
+	  && sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+	{
+	  char_len = mpz_get_si (sym->ts.cl->length->value.integer);
+	  init_expr->value.character.length = char_len;
+	  init_expr->value.character.string = gfc_getmem (char_len+1);
+	  ch = init_expr->value.character.string;
+	  for (i = 0; i < char_len; i++)
+	    *(ch++) = gfc_option.flag_init_character_value;
+	}
+      else
+	{
+	  gfc_free_expr (init_expr);
+	  init_expr = NULL;
+	}
+      break;
+	  
+    default:
+     gfc_free_expr (init_expr);
+     init_expr = NULL;
+    }
+  return init_expr;
+}
+
+/* Add an initialization expression to a local variable.  */
+static void
+apply_default_init_local (gfc_symbol *sym)
+{
+  gfc_expr *init = NULL;
+
+  /* The symbol should be a variable or a function return value.  */
+  if ((sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
+      || (sym->attr.function && sym->result != sym))
+    return;
+
+  /* Try to build the initializer expression.  If we can't initialize
+     this symbol, then init will be NULL.  */
+  init = build_default_init_expr (sym);
+  if (init == NULL)
+    return;
+
+  /* For saved variables, we don't want to add an initializer at 
+     function entry, so we just add a static initializer.  */
+  if (sym->attr.save || sym->ns->save_all)
+    {
+      /* Don't clobber an existing initializer!  */
+      gcc_assert (sym->value == NULL);
+      sym->value = init;
+      return;
+    }
+
+  build_init_assign (sym, init);
+}
 
 /* Resolution of common features of flavors variable and procedure.  */
 
@@ -6771,6 +6955,9 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 	}
     }
 
+  if (sym->value == NULL && sym->attr.referenced)
+    apply_default_init_local (sym); /* Try to apply a default initialization.  */
+
   /* Can the symbol have an initializer?  */
   flag = 0;
   if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy