+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
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. */
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;
-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
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,
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
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. */
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;
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
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. */
}
}
+ 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
+2007-09-20 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.
+
2007-09-20 Paolo Carlini <pcarlini@suse.de>
PR c++/33460
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
+
--- /dev/null
+! { 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
projects / platform / upstream / gcc.git / commitdiff