[PATCH, fortran] PR20441 -finit-local-zero

[PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

[-- Attachment #1: Type: text/plain, Size: 1640 bytes --]

:ADDPATCH fortran:


Hi all,

Here's a patch to add -finit-local-zero, as well as some finer-grained
options.  I have a working version of the runtime-controlled
initialization as discussed previously, but it still needs to be
cleaned up a bit, so I'll submit it as a separate patch:

http://gcc.gnu.org/ml/fortran/2007-06/msg00028.html

I've bootstrapped and regression tested this on x86_64-linux.
Everything passes in the ordinary regression tests, and with
RUNTESTFLAGS="--tool_opts -finit-local-zero" added, the only failures
are tests that invoke cc1 ("cc1: warning: command line option
"-finit-local-zero" is valid for Fortran but not for C").

-Asher


2007-08-17  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,
	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-*).
	(apple_default_init_local): Apply local initializer (-finit-*).
	(resolve_fl_variable): Try to add local initializer (-finit-*).
	* options.c (gfc_init_options, gfc_handle_option): Handle
	-finit-local-zero, -finit-real, -finit-integer, and -finit-logical
	flags.

2007-08-17  Asher Langton  <langton2@llnl.gov>

	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.

[-- Attachment #2: gfc070817_123829.diff --]
[-- Type: application/octet-stream, Size: 12347 bytes --]

Index: gfortran.h
===================================================================
--- gfortran.h	(revision 127568)
+++ gfortran.h	(working copy)
@@ -564,6 +564,37 @@ typedef enum
 }
 ioerror_codes;
 
+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_ZERO
+}
+init_local_character;
+
+typedef enum
+{
+  GFC_INIT_INTEGER_OFF = 0,
+  GFC_INIT_INTEGER_ON
+}
+init_local_integer;
 
 /************************* Structures *****************************/
 
@@ -1867,6 +1898,12 @@ typedef struct
   int flag_openmp;
   int flag_sign_zero;
   int flag_module_private;
+  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;
 
   int fpe;
 
Index: lang.opt
===================================================================
--- lang.opt	(revision 127568)
+++ lang.opt	(working copy)
@@ -196,6 +196,22 @@ fimplicit-none
 Fortran
 Specify that no implicit typing is allowed, unless overridden by explicit IMPLICIT statements
 
+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
Index: invoke.texi
===================================================================
--- invoke.texi	(revision 127568)
+++ invoke.texi	(working copy)
@@ -156,7 +156,8 @@ 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}}
+-fblas-matmul-limit=@var{n} -finit-local-zero -finit-integer=@var{n} @gol
+-finit-real=@var{<zero|inf|-inf|nan>} -finit-logical=@var{<true|false>} }
 @end table
 
 @menu
@@ -919,6 +920,24 @@ geometric mean of the dimensions of the 
 
 The default value for @var{n} is 30.
 
+@item -finit-local-zero
+@item -finit-integer=@var{n}
+@item -finit-real=@var{<zero|inf|-inf|nan>} 
+@item -finit-logical=@var{<true|false>}
+@opindex @code{finit-local-zero}
+@opindex @code{finit-integer}
+@opindex @code{finit-real}
+@opindex @code{finit-logical}
+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), and
+@option{-finit-logical=@var{<true|false>}} options.  
+
 @end table
 
 @xref{Code Gen Options,,Options for Code Generation Conventions,
Index: resolve.c
===================================================================
--- resolve.c	(revision 127568)
+++ resolve.c	(working copy)
@@ -6405,26 +6405,15 @@ is_non_constant_shape_array (gfc_symbol 
   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
@@ -6457,6 +6446,197 @@ 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;
+
+  /* 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_ZERO
+	  && 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;
+	  /* Set initial value to be a string of null characters.  */
+	  init_expr->value.character.string = gfc_getmem (char_len+1);
+	}
+      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.  */
 
@@ -6571,6 +6751,9 @@ resolve_fl_variable (gfc_symbol *sym, in
 	}
     }
 
+  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
Index: options.c
===================================================================
--- options.c	(revision 127568)
+++ options.c	(working copy)
@@ -103,6 +103,11 @@ gfc_init_options (unsigned int argc ATTR
   gfc_option.flag_d_lines = -1;
   gfc_option.flag_openmp = 0;
   gfc_option.flag_sign_zero = 1;
+  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.fpe = 0;
 
@@ -615,6 +620,43 @@ gfc_handle_option (size_t scode, const c
       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_ZERO;
+      break;
+
+    case OPT_finit_logical_:
+      if (!strcmp (arg, "false"))
+	gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
+      else if (!strcmp (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 (!strcmp (arg, "zero"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
+      else if (!strcmp (arg, "nan"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
+      else if (!strcmp (arg, "inf"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_INF;
+      else if (!strcmp (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_I:
       gfc_add_include_path (arg, true);
       break;

[-- Attachment #3: init_flag_1.f90 --]
[-- Type: application/octet-stream, Size: 1321 bytes --]

! { dg-do run }
! { dg-options "-finit-local-zero" }

program init_flag_1
  call real_test
  call logical_test
  call int_test
  call complex_test
  call char_test
end program init_flag_1

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 /= 0.0) call abort
  if (r2(2) /= 0.0) call abort
  if (r3(5,5) /= 0.0) call abort
  if (r4 /= 0.0) call abort
end subroutine real_test

subroutine logical_test
  logical l1
  logical l2(2)
  if (l1 .neqv. .false.) call abort
  if (l2(2) .neqv. .false.) call abort
end subroutine logical_test

subroutine int_test
  integer i1
  integer i2(10)
  dimension i3(10,10)
  if (i1 /= 0) call abort
  if (i2(2) /= 0) call abort
  if (i3(5,5) /= 0) call abort
  if (i4 /= 0) call abort
end subroutine int_test

subroutine complex_test
  complex c1
  complex c2(20,20)
  if (c1 /= (0.0,0.0)) call abort
  if (c2(1,1) /= (0.0,0.0)) call abort 
end subroutine complex_test

subroutine char_test
  character*1 c1
  character*8 c2, c3(5)
  character c4(10)
  if (c1 /= '\0') call abort
  if (c2 /= '\0\0\0\0\0\0\0\0') call abort
  if (c3(1) /= '\0\0\0\0\0\0\0\0') call abort
  if (c3(5) /= '\0\0\0\0\0\0\0\0') call abort
  if (c4(5) /= '\0') call abort
end subroutine char_test

[-- Attachment #4: init_flag_2.f90 --]
[-- Type: application/octet-stream, Size: 1035 bytes --]

! { dg-do run }
! { dg-options "-finit-integer=1 -finit-logical=true -finit-real=zero" }

program init_flag_2
  call real_test
  call logical_test
  call int_test
  call complex_test
end program init_flag_2

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 /= 0.0) call abort
  if (r2(2) /= 0.0) call abort
  if (r3(5,5) /= 0.0) call abort
  if (r4 /= 0.0) call abort
end subroutine real_test

subroutine logical_test
  logical l1
  logical l2(2)
  if (l1 .neqv. .true.) call abort
  if (l2(2) .neqv. .true.) call abort
end subroutine logical_test

subroutine int_test
  integer i1
  integer i2(10)
  dimension i3(10,10)
  if (i1 /= 1) call abort
  if (i2(2) /= 1) call abort
  if (i3(5,5) /= 1) call abort
  if (i4 /= 1) call abort
end subroutine int_test

subroutine complex_test
  complex c1
  complex c2(20,20)
  if (c1 /= (0.0,0.0)) call abort
  if (c2(1,1) /= (0.0,0.0)) call abort 
end subroutine complex_test

[-- Attachment #5: init_flag_3.f90 --]
[-- Type: application/octet-stream, Size: 1049 bytes --]

! { dg-do run }
! { dg-options "-finit-integer=-1 -finit-logical=false -finit-real=nan" }

program init_flag_3
  call real_test
  call logical_test
  call int_test
  call complex_test
end program init_flag_3

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 .eq. r1) call abort
  if (r2(2) .eq. r2(2)) call abort
  if (r3(5,5) .eq. r3(5,5)) call abort
  if (r4 .eq. r4) call abort
end subroutine real_test

subroutine logical_test
  logical l1
  logical l2(2)
  if (l1 .neqv. .false.) call abort
  if (l2(2) .neqv. .false.) call abort
end subroutine logical_test

subroutine int_test
  integer i1
  integer i2(10)
  dimension i3(10,10)
  if (i1 /= -1) call abort
  if (i2(2) /= -1) call abort
  if (i3(5,5) /= -1) call abort
  if (i4 /= -1) call abort
end subroutine int_test

subroutine complex_test
  complex c1
  complex c2(20,20)
  if (c1 .eq. c1) call abort
  if (c2(1,1) .eq. c2(1,1)) call abort 
end subroutine complex_test

[-- Attachment #6: init_flag_4.f90 --]
[-- Type: application/octet-stream, Size: 505 bytes --]

! { dg-do run }
! { dg-options "-finit-real=inf" }

program init_flag_4
  call real_test
end program init_flag_4

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 .le. 0 .or. r1 .ne. 2*r1) call abort
  if (r2(2) .le. 0 .or. r2(2) .ne. 2*r2(2)) call abort
  if (r3(5,5) .le. 0 .or. r3(5,5) .ne. 2*r3(5,5)) call abort
  if (r4 .le. 0 .or. r4 .ne. 2*r4) call abort
end subroutine real_test

[-- Attachment #7: init_flag_5.f90 --]
[-- Type: application/octet-stream, Size: 506 bytes --]

! { dg-do run }
! { dg-options "-finit-real=-inf" }

program init_flag_5
  call real_test
end program init_flag_5

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 .ge. 0 .or. r1 .ne. 2*r1) call abort
  if (r2(2) .ge. 0 .or. r2(2) .ne. 2*r2(2)) call abort
  if (r3(5,5) .ge. 0 .or. r3(5,5) .ne. 2*r3(5,5)) call abort
  if (r4 .ge. 0 .or. r4 .ne. 2*r4) call abort
end subroutine real_test

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Tobias Burnus]

Hi Asher,

Asher Langton wrote:
> Here's a patch to add -finit-local-zero,
Shouldn't also the derived variables be initialized?

type bar
  real :: r
  complex :: z
  integer :: i
  character(len=5) :: c
  logical :: l
end type bar
type(bar) :: t

print *, t%r; print *, t%z; print *, t%i;
print *, t%c; print *, t%l
end

With ifort and sunf95 they are set to zero; with "openf95 -zerouv" they
are zero. NAG f95 gives partially zeros (?) but -nan works.

I therefore think that -finit* also should initialize those. Replacing
"integer :: i" by "integer :: i = 5" changes the behaviour of gfortran
(independent of the -finit* options): Not only "i" is initalized but all
other variables are initialized to zero. Using -finit-real=nan I would
still expect NAN and not "0.0" ...


Tobias


PS: I wonder whether it makes sense to have -finit-character=c to
initially character variables with, e.g. "XXXXXXXXXXXXXXXXXXXX".

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

On 8/20/07, Tobias Burnus <burnus@net-b.de> wrote:
> Hi Asher,
>
> Asher Langton wrote:
> > Here's a patch to add -finit-local-zero,
> Shouldn't also the derived variables be initialized?
>
> type bar
>   real :: r
>   complex :: z
>   integer :: i
>   character(len=5) :: c
>   logical :: l
> end type bar
> type(bar) :: t
>
> print *, t%r; print *, t%z; print *, t%i;
> print *, t%c; print *, t%l
> end
>
> With ifort and sunf95 they are set to zero; with "openf95 -zerouv" they
> are zero. NAG f95 gives partially zeros (?) but -nan works.
>
> I therefore think that -finit* also should initialize those. Replacing
> "integer :: i" by "integer :: i = 5" changes the behaviour of gfortran
> (independent of the -finit* options): Not only "i" is initalized but all
> other variables are initialized to zero. Using -finit-real=nan I would
> still expect NAN and not "0.0" ...

Hi Tobias,

Thanks for the feedback.  I'll take a look at this and see what I can do.

> PS: I wonder whether it makes sense to have -finit-character=c to
> initially character variables with, e.g. "XXXXXXXXXXXXXXXXXXXX".

It makes sense, but I left it out because I didn't know if anyone
would find it useful.  I can easily add an finit-character option,
though.

-Asher

Re: [PATCH, fortran] PR20441 -finit-local-zero

[François-Xavier Coudert]

>> PS: I wonder whether it makes sense to have -finit-character=c to
>> initially character variables with, e.g. "XXXXXXXXXXXXXXXXXXXX".
>
> It makes sense, but I left it out because I didn't know if anyone
> would find it useful.  I can easily add an finit-character option,
> though.

I'd find it useful. I think -finit-character=32 would fill with
spaces, and so on (ie, using a ASCII value as argument).

FX

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Tobias Schlüter]

François-Xavier Coudert wrote:
>>> PS: I wonder whether it makes sense to have -finit-character=c to
>>> initially character variables with, e.g. "XXXXXXXXXXXXXXXXXXXX".
>> It makes sense, but I left it out because I didn't know if anyone
>> would find it useful.  I can easily add an finit-character option,
>> though.
> 
> I'd find it useful. I think -finit-character=32 would fill with
> spaces, and so on (ie, using a ASCII value as argument).

I'm wondering if all these options are really useful enough to justify 
their existence.  What additional benefit does this fine-grained control 
have over, say, one option that allows me to give a 32bit value that 
will be filled into any variable's space?  This suggestions allows 
behavior for -finit-local-zero, and therefore fixes the backwards 
ocmpatibility issue.  For debugging, I don't think there's a realistic 
case where this is not sufficient.

I'm somewhat doubtful that the maintenance overhead is worth the general 
solution.  We have already identified two cases previously not thought 
of in this thread.  Another issue that has remained unadressed so far: 
what happens if I initialize a INTEGER*1 to 2**20?  I'm sure I could 
think of more issues or potential headaches.

Cheers,
- Tobi

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

On 8/20/07, Tobias Burnus <burnus@net-b.de> wrote:
> Hi Asher,
>
> Asher Langton wrote:
> > Here's a patch to add -finit-local-zero,
> Shouldn't also the derived variables be initialized?
>
> type bar
>   real :: r
>   complex :: z
>   integer :: i
>   character(len=5) :: c
>   logical :: l
> end type bar
> type(bar) :: t
>
> print *, t%r; print *, t%z; print *, t%i;
> print *, t%c; print *, t%l
> end
>
> With ifort and sunf95 they are set to zero; with "openf95 -zerouv" they
> are zero. NAG f95 gives partially zeros (?) but -nan works.
>
> I therefore think that -finit* also should initialize those. Replacing
> "integer :: i" by "integer :: i = 5" changes the behaviour of gfortran
> (independent of the -finit* options): Not only "i" is initalized but all
> other variables are initialized to zero. Using -finit-real=nan I would
> still expect NAN and not "0.0" ...

Hi Tobias,

I've thought about this quite a bit, and I haven't come up with a good
solution.  If some of the components have initializers, then I can add
initializers to the gfc_constructor for the remaining components (in
expr.c::gfc_default_initializer()).  However, I couldn't find a
straightforward way to avoid initializing derived types variables that
appear in equivalence statements, so this fails in
gfortran.dg/equiv_7.f90::derived_types().

Handling arbitrary derived types is tougher.  For a scalar derived
type, it would suffice to run through the components and generate some
initialization statements, but initializing arrays of derived types is
more difficult.  It can probably done by abusing the gfc_constructor
initializers and letting trans-expr.c::gfc_trans_assignment() handle
the scalarization, but I haven't figured out a clean way to do this.

For now, my inclination is to leave derived type initialization as a
TODO and document the -finit-* limitations in the manual.  If that's
acceptable, I'll put together a fresh patch with the added
documentation, as well as an -finit-character option.

-Asher

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

[-- Attachment #1: Type: text/plain, Size: 3508 bytes --]

Hi all,

Here's an updated patch.  I've added -finit-character=<n>, where 0 <=
n <= 127 is an ASCII value.  Derived types aren't initialized, but
I've documented this in the manual.  I've added a test that checks
initialization of SAVE'd variables.  This has been bootstrapped (+make
pdf) and regression tested on x86_64-unknown-linux-gnu.

I won't have reliable internet access for the next couple of days, but
I'll be back online by Monday evening.


-Asher

2007-08-31  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-08-31  Asher Langton  <langton2@llnl.gov>

	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.





On 8/17/07, Asher Langton <langton2@llnl.gov> wrote:
> :ADDPATCH fortran:
>
>
> Hi all,
>
> Here's a patch to add -finit-local-zero, as well as some finer-grained
> options.  I have a working version of the runtime-controlled
> initialization as discussed previously, but it still needs to be
> cleaned up a bit, so I'll submit it as a separate patch:
>
> http://gcc.gnu.org/ml/fortran/2007-06/msg00028.html
>
> I've bootstrapped and regression tested this on x86_64-linux.
> Everything passes in the ordinary regression tests, and with
> RUNTESTFLAGS="--tool_opts -finit-local-zero" added, the only failures
> are tests that invoke cc1 ("cc1: warning: command line option
> "-finit-local-zero" is valid for Fortran but not for C").
>
> -Asher
>
>
> 2007-08-17  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,
>         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-*).
>         (apple_default_init_local): Apply local initializer (-finit-*).
>         (resolve_fl_variable): Try to add local initializer (-finit-*).
>         * options.c (gfc_init_options, gfc_handle_option): Handle
>         -finit-local-zero, -finit-real, -finit-integer, -finit-logical
>         flags, and -finit-character flags.
>
> 2007-08-17  Asher Langton  <langton2@llnl.gov>
>
>         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.
>
>

[-- Attachment #2: gfc070831_142756.diff --]
[-- Type: application/octet-stream, Size: 13504 bytes --]

Index: gfortran.h
===================================================================
--- gfortran.h	(revision 127997)
+++ gfortran.h	(working copy)
@@ -564,6 +564,37 @@ typedef enum
 }
 ioerror_codes;
 
+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 *****************************/
 
@@ -1868,6 +1899,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;
 
Index: lang.opt
===================================================================
--- lang.opt	(revision 127997)
+++ lang.opt	(working copy)
@@ -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
Index: invoke.texi
===================================================================
--- invoke.texi	(revision 127997)
+++ invoke.texi	(working copy)
@@ -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,28 @@ Allow indirect recursion by forcing all 
 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.  (This limitation may be removed in future releases).
 @end table
 
 @xref{Code Gen Options,,Options for Code Generation Conventions,
Index: resolve.c
===================================================================
--- resolve.c	(revision 127997)
+++ resolve.c	(working copy)
@@ -6553,26 +6553,15 @@ is_non_constant_shape_array (gfc_symbol 
   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
@@ -6605,6 +6594,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.  */
 
@@ -6719,6 +6903,9 @@ resolve_fl_variable (gfc_symbol *sym, in
 	}
     }
 
+  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
Index: options.c
===================================================================
--- options.c	(revision 127997)
+++ options.c	(working copy)
@@ -107,7 +107,13 @@ gfc_init_options (unsigned int argc ATTR
   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 c
       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 (!strcmp (arg, "false"))
+	gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
+      else if (!strcmp (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 (!strcmp (arg, "zero"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
+      else if (!strcmp (arg, "nan"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
+      else if (!strcmp (arg, "inf"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_INF;
+      else if (!strcmp (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;

[-- Attachment #3: init_flag_1.f90 --]
[-- Type: application/octet-stream, Size: 1321 bytes --]

! { dg-do run }
! { dg-options "-finit-local-zero" }

program init_flag_1
  call real_test
  call logical_test
  call int_test
  call complex_test
  call char_test
end program init_flag_1

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 /= 0.0) call abort
  if (r2(2) /= 0.0) call abort
  if (r3(5,5) /= 0.0) call abort
  if (r4 /= 0.0) call abort
end subroutine real_test

subroutine logical_test
  logical l1
  logical l2(2)
  if (l1 .neqv. .false.) call abort
  if (l2(2) .neqv. .false.) call abort
end subroutine logical_test

subroutine int_test
  integer i1
  integer i2(10)
  dimension i3(10,10)
  if (i1 /= 0) call abort
  if (i2(2) /= 0) call abort
  if (i3(5,5) /= 0) call abort
  if (i4 /= 0) call abort
end subroutine int_test

subroutine complex_test
  complex c1
  complex c2(20,20)
  if (c1 /= (0.0,0.0)) call abort
  if (c2(1,1) /= (0.0,0.0)) call abort 
end subroutine complex_test

subroutine char_test
  character*1 c1
  character*8 c2, c3(5)
  character c4(10)
  if (c1 /= '\0') call abort
  if (c2 /= '\0\0\0\0\0\0\0\0') call abort
  if (c3(1) /= '\0\0\0\0\0\0\0\0') call abort
  if (c3(5) /= '\0\0\0\0\0\0\0\0') call abort
  if (c4(5) /= '\0') call abort
end subroutine char_test

[-- Attachment #4: init_flag_2.f90 --]
[-- Type: application/octet-stream, Size: 1035 bytes --]

! { dg-do run }
! { dg-options "-finit-integer=1 -finit-logical=true -finit-real=zero" }

program init_flag_2
  call real_test
  call logical_test
  call int_test
  call complex_test
end program init_flag_2

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 /= 0.0) call abort
  if (r2(2) /= 0.0) call abort
  if (r3(5,5) /= 0.0) call abort
  if (r4 /= 0.0) call abort
end subroutine real_test

subroutine logical_test
  logical l1
  logical l2(2)
  if (l1 .neqv. .true.) call abort
  if (l2(2) .neqv. .true.) call abort
end subroutine logical_test

subroutine int_test
  integer i1
  integer i2(10)
  dimension i3(10,10)
  if (i1 /= 1) call abort
  if (i2(2) /= 1) call abort
  if (i3(5,5) /= 1) call abort
  if (i4 /= 1) call abort
end subroutine int_test

subroutine complex_test
  complex c1
  complex c2(20,20)
  if (c1 /= (0.0,0.0)) call abort
  if (c2(1,1) /= (0.0,0.0)) call abort 
end subroutine complex_test

[-- Attachment #5: init_flag_3.f90 --]
[-- Type: application/octet-stream, Size: 1049 bytes --]

! { dg-do run }
! { dg-options "-finit-integer=-1 -finit-logical=false -finit-real=nan" }

program init_flag_3
  call real_test
  call logical_test
  call int_test
  call complex_test
end program init_flag_3

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 .eq. r1) call abort
  if (r2(2) .eq. r2(2)) call abort
  if (r3(5,5) .eq. r3(5,5)) call abort
  if (r4 .eq. r4) call abort
end subroutine real_test

subroutine logical_test
  logical l1
  logical l2(2)
  if (l1 .neqv. .false.) call abort
  if (l2(2) .neqv. .false.) call abort
end subroutine logical_test

subroutine int_test
  integer i1
  integer i2(10)
  dimension i3(10,10)
  if (i1 /= -1) call abort
  if (i2(2) /= -1) call abort
  if (i3(5,5) /= -1) call abort
  if (i4 /= -1) call abort
end subroutine int_test

subroutine complex_test
  complex c1
  complex c2(20,20)
  if (c1 .eq. c1) call abort
  if (c2(1,1) .eq. c2(1,1)) call abort 
end subroutine complex_test

[-- Attachment #6: init_flag_4.f90 --]
[-- Type: application/octet-stream, Size: 505 bytes --]

! { dg-do run }
! { dg-options "-finit-real=inf" }

program init_flag_4
  call real_test
end program init_flag_4

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 .le. 0 .or. r1 .ne. 2*r1) call abort
  if (r2(2) .le. 0 .or. r2(2) .ne. 2*r2(2)) call abort
  if (r3(5,5) .le. 0 .or. r3(5,5) .ne. 2*r3(5,5)) call abort
  if (r4 .le. 0 .or. r4 .ne. 2*r4) call abort
end subroutine real_test

[-- Attachment #7: init_flag_5.f90 --]
[-- Type: application/octet-stream, Size: 506 bytes --]

! { dg-do run }
! { dg-options "-finit-real=-inf" }

program init_flag_5
  call real_test
end program init_flag_5

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine real_test
  real r1
  real r2(10)
  dimension r3(10,10)
  if (r1 .ge. 0 .or. r1 .ne. 2*r1) call abort
  if (r2(2) .ge. 0 .or. r2(2) .ne. 2*r2(2)) call abort
  if (r3(5,5) .ge. 0 .or. r3(5,5) .ne. 2*r3(5,5)) call abort
  if (r4 .ge. 0 .or. r4 .ne. 2*r4) call abort
end subroutine real_test

[-- Attachment #8: init_flag_6.f90 --]
[-- Type: application/octet-stream, Size: 494 bytes --]

! { dg-do run }
! { dg-options "-finit-character=32" }

program init_flag_6
  call char_test
end program init_flag_6

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine char_test
  character*1 c1
  character*8 c2, c3(5)
  character c4(10)
  if (c1 /= ' ') call abort
  if (c2 /= '        ') call abort
  if (c3(1) /= '        ') call abort
  if (c3(5) /= '        ') call abort
  if (c4(5) /= ' ') call abort
end subroutine char_test
        

[-- Attachment #9: init_flag_7.f90 --]
[-- Type: application/octet-stream, Size: 1021 bytes --]

! { dg-do run }
! { dg-options "-finit-integer=101" }

program init_flag_7
  call save_test1 (.true.)
  call save_test1 (.false.) 
  call save_test2 (.true.)
  call save_test2 (.false.)
end program init_flag_7

! Test some initializations for both implicitly and
! explicitly declared local variables.
subroutine save_test1 (first)
  logical first
  integer :: i1 = -100
  integer i2
  integer i3
  save i2
  if (first) then
     if (i1 .ne. -100) call abort
     if (i2 .ne. 101) call abort
     if (i3 .ne. 101) call abort
  else
     if (i1 .ne. 1001) call abort
     if (i2 .ne. 1002) call abort
     if (i3 .ne. 101) call abort
  end if
  i1 = 1001
  i2 = 1002
  i3 = 1003
end subroutine save_test1
        
subroutine save_test2 (first)
  logical first
  integer :: i1 = -100
  integer i2
  save
  if (first) then
     if (i1 .ne. -100) call abort
     if (i2 .ne. 101) call abort
  else
     if (i1 .ne. 1001) call abort
     if (i2 .ne. 1002) call abort
  end if
  i1 = 1001
  i2 = 1002
end subroutine save_test2

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Thomas Koenig]

Asher Langton wrote:

Hi Asher,

> Here's an updated patch.  I've added -finit-character=<n>, where 0 <=
> n <= 127 is an ASCII value.  Derived types aren't initialized, but
> I've documented this in the manual.  I've added a test that checks
> initialization of SAVE'd variables.  This has been bootstrapped (+make
> pdf) and regression tested on x86_64-unknown-linux-gnu.

Equivalenced variables are not initialized by your patch:

$ cat foo.f
      program main
      call foo
      end
      subroutine foo
      equivalence(i,j)
      print *,j
      end
$ g77 -finit-local-zero foo.f && ./a.out
 0
$ gfortran -finit-local-zero foo.f && ./a.out
           1

This behavior is different from g77, so I think it should be either
documented, or the behavior changed to match g77.  Of course, if the
user specifies -finit-integer and -finit-real and equivalences the
values, he's on his own :-)

	Thomas

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Tobias Burnus]

Hi all,

Asher Langton wrote:
> 2007-08-31  Asher Langton  <langton2@llnl.gov>
>
> 	PR fortran/20441
>         * gfortran.h : Add init_local_* enums and init_flag_* flags to
> 	gfc_option_t.
> [...]
>   

Thomas König wrote:
> Equivalenced variables are not initialized by your patch:
> [...]
> This behavior is different from g77, so I think it should be either
> documented, or the behavior changed to match g77.

(Side note: On my system I was not able to get non-zero equivalenced
variables with gfortran [NAG f95 had them for the same program]; though
I don't know why they were zero.)

I am very much in favour of including this patch in GCC 4.3.0 as it is
(a) a regression with regards to g77, (b) there are still several
applications around which bluntly assume that local variables (esp.
integer variables) are initialized by zero [e.g. the
quantum-physics/-chemistry program Wien2k], (c) the patch has been
submitted before stage 3, which we entered very recently.

I therefore suggest to patch the documentation (see patch below) and
include it otherwise as is. For improvements (derived types,
equivalence, optionally initializing intent(OUT) dummies [etc.?]), we
can fill (a) PR(s) and handle them later.

To the patch itself:
http://gcc.gnu.org/ml/fortran/2007-08/msg00666.html

+      else if (!strcmp (arg, "nan"))

I am wondering whether one should use strcasecmp instead (as people like
to write INF, NaN,...), but I do not have a real opinion on this.


+@option{-finit-real=@var{<zero|inf|-inf|nan>}} (which also initializes
+the real and imaginary parts of local @code{COMPLEX} variables),

I wonder whether one should add something like
"Note: @var{nan} initializes REAL and COMPLEX variables with a quiet NaN."
as some might expect that the NaN are signalling.*


From my side this patch (with the patch below) is OK for the trunk -
unless someone comes up with reasons why this patch should not be
checked in (as is).

Tobias

--- invoke.texi.old     2007-09-14 10:25:20.000000000 +0200
+++ invoke.texi 2007-09-14 10:27:28.000000000 +0200
@@ -954,7 +954,8 @@
 @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.  (This limitation may be removed in future releases).
+type variables nor equivalenced variables.
+(These limitations may be removed in future releases).
 @end table

 @xref{Code Gen Options,,Options for Code Generation Conventions,

Re: [PATCH, fortran] PR20441 -finit-local-zero

[François-Xavier Coudert]

> I am very much in favour of including this patch in GCC 4.3.0

Same opinion here.

> the patch has been submitted before stage 3, which we entered very recently.

Yep, the rule is about patch submission date, not approval.

FX

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

Hi all,

I somehow missed Thomas's original message entirely.  I will take a
look at equivalenced variables tonight.

-Asher

On 9/12/07, Tobias Burnus <burnus@net-b.de> wrote:
> Asher Langton wrote:
> > Here's an updated patch.
>
> Thomas König wrote:
> > Equivalenced variables are not initialized by your patch:
> > [...]
> > This behavior is different from g77, so I think it should be either
> > documented, or the behavior changed to match g77.
>
> Could you send an updated patch (e.g. with documentation update only)
> rather soonish. I think we can then still include this patch in stage 3
> (starts today) as the initial patch has been submitted before stage 3
> has started. I really would like to see this patch in 4.3.x (I have some
> programs which don't initialize local variables). I think we can worry
> about finer points (equivalence, derived types) later. Unless you have a
> patch ready which initializes also equivalence.
>
> (I have to admit that on my system Thomas' equivalence example did not
> work: the variables were always zero with any options.)
>
> Tobias
>

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

On 9/14/07, Tobias Burnus <burnus@net-b.de> wrote:
> +      else if (!strcmp (arg, "nan"))
>
> I am wondering whether one should use strcasecmp instead (as people like
> to write INF, NaN,...), but I do not have a real opinion on this.

That's a good idea, and it certainly won't harm anything.

>
> +@option{-finit-real=@var{<zero|inf|-inf|nan>}} (which also initializes
> +the real and imaginary parts of local @code{COMPLEX} variables),
>
> I wonder whether one should add something like
> "Note: @var{nan} initializes REAL and COMPLEX variables with a quiet NaN."
> as some might expect that the NaN are signalling.*


I'll add something like this.  Eventually, I'd like to add
finit-real=<snan,qnan> options, but so far I haven't come up with a
nice kludge to deal with sNaNs in mpfr.


-Asher

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Thomas Koenig]

On Fri, 2007-09-14 at 07:44 -0500, Asher Langton wrote:

Hi Asher,

> I will take a
> look at equivalenced variables tonight.

Any progress?  If you haven't got a round tuit, I'd be in favor of
committing right now, and updating the documentation according to
Tobias Burnus' suggestion.

	Thomas

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

On 9/19/07, Thomas Koenig <tkoenig@alice-dsl.net> wrote:
> On Fri, 2007-09-14 at 07:44 -0500, Asher Langton wrote:
>
> Hi Asher,
>
> > I will take a
> > look at equivalenced variables tonight.
>
> Any progress?  If you haven't got a round tuit, I'd be in favor of
> committing right now, and updating the documentation according to
> Tobias Burnus' suggestion.

Okay, that sounds good to me.  I'd like to look into the equivalence
issue some more, but the last few days have been quite hectic.  I'll
put together an updated patch with the added documentation, and then
deal with the equivalence issue when I have a little more time.

-Asher

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

[-- Attachment #1: Type: text/plain, Size: 933 bytes --]

On 9/19/07, Asher Langton <langton2@llnl.gov> wrote:
> On 9/19/07, Thomas Koenig <tkoenig@alice-dsl.net> wrote:
> > On Fri, 2007-09-14 at 07:44 -0500, Asher Langton wrote:
> >
> > Hi Asher,
> >
> > > I will take a
> > > look at equivalenced variables tonight.
> >
> > Any progress?  If you haven't got a round tuit, I'd be in favor of
> > committing right now, and updating the documentation according to
> > Tobias Burnus' suggestion.
>
> Okay, that sounds good to me.  I'd like to look into the equivalence
> issue some more, but the last few days have been quite hectic.  I'll
> put together an updated patch with the added documentation, and then
> deal with the equivalence issue when I have a little more time.

Here's an updated patch.  The Changelog and the tests are the same as here:

http://gcc.gnu.org/ml/fortran/2007-08/msg00666.html

I bootstrapped and regression tested this on x86_64-linux.  Okay to commit?


-Asher

[-- Attachment #2: gfc070919_214008.diff --]
[-- Type: application/octet-stream, Size: 13816 bytes --]

Index: gfortran.h
===================================================================
--- gfortran.h	(revision 128613)
+++ gfortran.h	(working copy)
@@ -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.  */
@@ -1822,6 +1854,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;
 
Index: lang.opt
===================================================================
--- lang.opt	(revision 128613)
+++ lang.opt	(working copy)
@@ -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
Index: invoke.texi
===================================================================
--- invoke.texi	(revision 128613)
+++ invoke.texi	(working copy)
@@ -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 
 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,
Index: resolve.c
===================================================================
--- resolve.c	(revision 128613)
+++ resolve.c	(working copy)
@@ -6566,26 +6566,15 @@ is_non_constant_shape_array (gfc_symbol 
   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
@@ -6618,6 +6607,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.  */
 
@@ -6732,6 +6916,9 @@ resolve_fl_variable (gfc_symbol *sym, in
 	}
     }
 
+  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
Index: options.c
===================================================================
--- options.c	(revision 128613)
+++ options.c	(working copy)
@@ -107,7 +107,13 @@ gfc_init_options (unsigned int argc ATTR
   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 c
       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;

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Tobias Burnus]

Asher Langton wrote:
> Here's an updated patch.  The Changelog and the tests are the same as here:
>
> http://gcc.gnu.org/ml/fortran/2007-08/msg00666.html
>
> I bootstrapped and regression tested this on x86_64-linux.  Okay to commit?
>   

Checking the interdiff, it looks good.

OK for the trunk and thank you for the patch. (If one looks at a very
recent thread at comp.lang.fortran, one sees that people are missing
that option.)


This fixes PR 20441; follow up PRs are PR33430 (optionally initialize
also intent(out) variables) and PR31447 (initialize derived compounds,
equivalenced variables and support sNaN). Did I miss something regarding
the follow-up PRs?

Tobias

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Thomas Koenig]

On Thu, 2007-09-20 at 10:32 +0200, Tobias Burnus wrote:

> This fixes PR 20441; follow up PRs are PR33430 (optionally initialize
> also intent(out) variables) and PR31447 (initialize derived compounds,
> equivalenced variables and support sNaN). Did I miss something regarding
> the follow-up PRs?

We need either to leave PR 20441 open, with a reminder that equivalenced
variables still aren't initialized, or to open a new PR.

	Thomas

Re: [PATCH, fortran] PR20441 -finit-local-zero

[FX Coudert]

>> PR31447 (initialize derived compounds,
>> equivalenced variables and support sNaN)
>
> We need either to leave PR 20441 open, with a reminder that  
> equivalenced
> variables still aren't initialized

This seems to be in PR31447 already.

FX

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Thomas Koenig]

On Thu, 2007-09-20 at 20:40 +0100, FX Coudert wrote:
> >> PR31447 (initialize derived compounds,
> >> equivalenced variables and support sNaN)
> >
> > We need either to leave PR 20441 open, with a reminder that  
> > equivalenced
> > variables still aren't initialized
> 
> This seems to be in PR31447 already.

Yes, you're right.  It's OK then.

	Thomas

Re: [PATCH, fortran] PR20441 -finit-local-zero

[Asher Langton]

On 9/20/07, Thomas Koenig <tkoenig@alice-dsl.net> wrote:
> On Thu, 2007-09-20 at 20:40 +0100, FX Coudert wrote:
> > >> PR31447 (initialize derived compounds,
> > >> equivalenced variables and support sNaN)
> > >
> > > We need either to leave PR 20441 open, with a reminder that
> > > equivalenced
> > > variables still aren't initialized
> >
> > This seems to be in PR31447 already.
>
> Yes, you're right.  It's OK then.

Thanks Thomas, FX, and Tobias for the review.  I've committed the
patch and closed PR 20441.

-Asher