From a28eb9a86954e46488228a9a434f816ca39ee194 Mon Sep 17 00:00:00 2001 From: langton Date: Fri, 21 Sep 2007 02:34:14 +0000 Subject: [PATCH] PR fortran/20441 * gfortran.h : Add init_local_* enums and init_flag_* flags to gfc_option_t. * lang.opt: Add -finit-local-zero, -finit-real, -finit-integer, -finit-character, and -finit-logical flags. * invoke.texi: Document new options. * resolve.c (build_init_assign): New function. (apply_init_assign): Move part of function into build_init_assign. (build_default_init_expr): Build local initializer (-finit-*). (apply_default_init_local): Apply local initializer (-finit-*). (resolve_fl_variable): Try to add local initializer (-finit-*). * options.c (gfc_init_options, gfc_handle_option, gfc_post_options): Handle -finit-local-zero, -finit-real, -finit-integer, -finit-character, and -finit-logical flags. PR fortran/20441 * gfortran.dg/init_flag_1.f90: New. * gfortran.dg/init_flag_2.f90: New. * gfortran.dg/init_flag_3.f90: New. * gfortran.dg/init_flag_4.f90: New. * gfortran.dg/init_flag_5.f90: New. * gfortran.dg/init_flag_6.f90: New. * gfortran.dg/init_flag_7.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128643 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 17 +++ gcc/fortran/gfortran.h | 39 ++++++ gcc/fortran/invoke.texi | 31 ++++- gcc/fortran/lang.opt | 20 +++ gcc/fortran/options.c | 57 +++++++- gcc/fortran/resolve.c | 215 ++++++++++++++++++++++++++++-- gcc/testsuite/ChangeLog | 11 ++ gcc/testsuite/gfortran.dg/init_flag_1.f90 | 57 ++++++++ gcc/testsuite/gfortran.dg/init_flag_2.f90 | 45 +++++++ gcc/testsuite/gfortran.dg/init_flag_3.f90 | 45 +++++++ gcc/testsuite/gfortran.dg/init_flag_4.f90 | 18 +++ gcc/testsuite/gfortran.dg/init_flag_5.f90 | 18 +++ gcc/testsuite/gfortran.dg/init_flag_6.f90 | 20 +++ gcc/testsuite/gfortran.dg/init_flag_7.f90 | 47 +++++++ 14 files changed, 624 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/init_flag_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/init_flag_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/init_flag_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/init_flag_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/init_flag_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/init_flag_6.f90 create mode 100644 gcc/testsuite/gfortran.dg/init_flag_7.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5a81ebe71d4..e9030900eba 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2007-09-20 Asher Langton + + 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 PR fortran/33221 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 32b15616600..42002cee21e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -510,6 +510,38 @@ enum gfc_isym_id typedef enum gfc_isym_id gfc_isym_id; +typedef enum +{ + GFC_INIT_REAL_OFF = 0, + GFC_INIT_REAL_ZERO, + GFC_INIT_REAL_NAN, + GFC_INIT_REAL_INF, + GFC_INIT_REAL_NEG_INF +} +init_local_real; + +typedef enum +{ + GFC_INIT_LOGICAL_OFF = 0, + GFC_INIT_LOGICAL_FALSE, + GFC_INIT_LOGICAL_TRUE +} +init_local_logical; + +typedef enum +{ + GFC_INIT_CHARACTER_OFF = 0, + GFC_INIT_CHARACTER_ON +} +init_local_character; + +typedef enum +{ + GFC_INIT_INTEGER_OFF = 0, + GFC_INIT_INTEGER_ON +} +init_local_integer; + /************************* Structures *****************************/ /* Used for keeping things in balanced binary trees. */ @@ -1823,6 +1855,13 @@ typedef struct int flag_sign_zero; int flag_module_private; int flag_recursive; + int flag_init_local_zero; + int flag_init_integer; + int flag_init_integer_value; + int flag_init_real; + int flag_init_logical; + int flag_init_character; + char flag_init_character_value; int fpe; diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 1388b6c123e..754974fe8c7 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -156,7 +156,9 @@ and warnings}. -fsecond-underscore @gol -fbounds-check -fmax-stack-var-size=@var{n} @gol -fpack-derived -frepack-arrays -fshort-enums -fexternal-blas @gol --fblas-matmul-limit=@var{n} -frecursive} +-fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol +-finit-integer=@var{n} -finit-real=@var{} @gol +-finit-logical=@var{} -finit-character=@var{n}} @end table @menu @@ -931,6 +933,33 @@ Allow indirect recursion by forcing all local arrays to be allocated on the stack. This flag cannot be used together with @option{-fmax-stack-var-size=} or @option{-fno-automatic}. +@item -finit-local-zero +@item -finit-integer=@var{n} +@item -finit-real=@var{} +@item -finit-logical=@var{} +@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{}} (which also initializes +the real and imaginary parts of local @code{COMPLEX} variables), +@option{-finit-logical=@var{}}, and +@option{-finit-character=@var{n}} (where @var{n} is an ASCII character +value) options. These options do not initialize components of derived +type variables, nor do they initialize variables that appear in an +@code{EQUIVALENCE} statement. (This limitation may be removed in +future releases). + +Note that the @option{-finit-real=nan} option initializes @code{REAL} +and @code{COMPLEX} variables with a quiet NaN. @end table @xref{Code Gen Options,,Options for Code Generation Conventions, diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 558cf657aac..55e8b516028 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -196,6 +196,26 @@ fimplicit-none Fortran Specify that no implicit typing is allowed, unless overridden by explicit IMPLICIT statements +finit-character= +Fortran RejectNegative Joined UInteger +-finit-character= Initialize local character variables to ASCII value n + +finit-integer= +Fortran RejectNegative Joined +-finit-integer= Initialize local integer variables to n + +finit-local-zero +Fortran +Initialize local variables to zero (from g77) + +finit-logical= +Fortran RejectNegative Joined +-finit-logical= Initialize local logical variables + +finit-real= +Fortran RejectNegative Joined +-finit-real= Initialize local real variables + fmax-errors= Fortran RejectNegative Joined UInteger -fmax-errors= Maximum number of errors to report diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 2d11ad7dfd6..5c3aefa4fe1 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -107,7 +107,13 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, gfc_option.flag_openmp = 0; gfc_option.flag_sign_zero = 1; gfc_option.flag_recursive = 0; - + gfc_option.flag_init_integer = GFC_INIT_INTEGER_OFF; + gfc_option.flag_init_integer_value = 0; + gfc_option.flag_init_real = GFC_INIT_REAL_OFF; + gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF; + gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF; + gfc_option.flag_init_character_value = (char)0; + gfc_option.fpe = 0; /* Argument pointers cannot point to anything but their argument. */ @@ -650,6 +656,55 @@ gfc_handle_option (size_t scode, const char *arg, int value) gfc_option.flag_default_double = value; break; + case OPT_finit_local_zero: + gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON; + gfc_option.flag_init_integer_value = 0; + gfc_option.flag_init_real = GFC_INIT_REAL_ZERO; + gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE; + gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON; + gfc_option.flag_init_character_value = (char)0; + break; + + case OPT_finit_logical_: + if (!strcasecmp (arg, "false")) + gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE; + else if (!strcasecmp (arg, "true")) + gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE; + else + gfc_fatal_error ("Unrecognized option to -finit-logical: %s", + arg); + break; + + case OPT_finit_real_: + if (!strcasecmp (arg, "zero")) + gfc_option.flag_init_real = GFC_INIT_REAL_ZERO; + else if (!strcasecmp (arg, "nan")) + gfc_option.flag_init_real = GFC_INIT_REAL_NAN; + else if (!strcasecmp (arg, "inf")) + gfc_option.flag_init_real = GFC_INIT_REAL_INF; + else if (!strcasecmp (arg, "-inf")) + gfc_option.flag_init_real = GFC_INIT_REAL_NEG_INF; + else + gfc_fatal_error ("Unrecognized option to -finit-real: %s", + arg); + break; + + case OPT_finit_integer_: + gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON; + gfc_option.flag_init_integer_value = atoi (arg); + break; + + case OPT_finit_character_: + if (value >= 0 && value <= 127) + { + gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON; + gfc_option.flag_init_character_value = (char)value; + } + else + gfc_fatal_error ("The value of n in -finit-character=n must be " + "between 0 and 127"); + break; + case OPT_I: gfc_add_include_path (arg, true); break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 26632bbde84..2f578e736d5 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6605,26 +6605,15 @@ is_non_constant_shape_array (gfc_symbol *sym) return not_constant; } - -/* Assign the default initializer to a derived type variable or result. */ - +/* Given a symbol and an initialization expression, add code to initialize + the symbol to the function entry. */ static void -apply_default_init (gfc_symbol *sym) +build_init_assign (gfc_symbol *sym, gfc_expr *init) { gfc_expr *lval; - gfc_expr *init = NULL; gfc_code *init_st; gfc_namespace *ns = sym->ns; - if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function) - return; - - if (sym->ts.type == BT_DERIVED && sym->ts.derived) - init = gfc_default_initializer (&sym->ts); - - if (init == NULL) - return; - /* Search for the function namespace if this is a contained function without an explicit result. */ if (sym->attr.function && sym == sym->result @@ -6657,6 +6646,201 @@ apply_default_init (gfc_symbol *sym) init_st->expr2 = init; } +/* Assign the default initializer to a derived type variable or result. */ + +static void +apply_default_init (gfc_symbol *sym) +{ + gfc_expr *init = NULL; + + if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function) + return; + + if (sym->ts.type == BT_DERIVED && sym->ts.derived) + init = gfc_default_initializer (&sym->ts); + + if (init == NULL) + return; + + build_init_assign (sym, init); +} + +/* Build an initializer for a local integer, real, complex, logical, or + character variable, based on the command line flags finit-local-zero, + finit-integer=, finit-real=, finit-logical=, and finit-runtime. Returns + null if the symbol should not have a default initialization. */ +static gfc_expr * +build_default_init_expr (gfc_symbol *sym) +{ + int char_len; + gfc_expr *init_expr; + int i; + char *ch; + + /* These symbols should never have a default initialization. */ + if ((sym->attr.dimension && !gfc_is_compile_time_shape (sym->as)) + || sym->attr.external + || sym->attr.dummy + || sym->attr.pointer + || sym->attr.in_equivalence + || sym->attr.in_common + || sym->attr.data + || sym->module + || sym->attr.cray_pointee + || sym->attr.cray_pointer) + return NULL; + + /* Now we'll try to build an initializer expression. */ + init_expr = gfc_get_expr (); + init_expr->expr_type = EXPR_CONSTANT; + init_expr->ts.type = sym->ts.type; + init_expr->ts.kind = sym->ts.kind; + init_expr->where = sym->declared_at; + + /* We will only initialize integers, reals, complex, logicals, and + characters, and only if the corresponding command-line flags + were set. Otherwise, we free init_expr and return null. */ + switch (sym->ts.type) + { + case BT_INTEGER: + if (gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF) + mpz_init_set_si (init_expr->value.integer, + gfc_option.flag_init_integer_value); + else + { + gfc_free_expr (init_expr); + init_expr = NULL; + } + break; + + case BT_REAL: + mpfr_init (init_expr->value.real); + switch (gfc_option.flag_init_real) + { + case GFC_INIT_REAL_NAN: + mpfr_set_nan (init_expr->value.real); + break; + + case GFC_INIT_REAL_INF: + mpfr_set_inf (init_expr->value.real, 1); + break; + + case GFC_INIT_REAL_NEG_INF: + mpfr_set_inf (init_expr->value.real, -1); + break; + + case GFC_INIT_REAL_ZERO: + mpfr_set_ui (init_expr->value.real, 0.0, GFC_RND_MODE); + break; + + default: + gfc_free_expr (init_expr); + init_expr = NULL; + break; + } + break; + + case BT_COMPLEX: + mpfr_init (init_expr->value.complex.r); + mpfr_init (init_expr->value.complex.i); + switch (gfc_option.flag_init_real) + { + case GFC_INIT_REAL_NAN: + mpfr_set_nan (init_expr->value.complex.r); + mpfr_set_nan (init_expr->value.complex.i); + break; + + case GFC_INIT_REAL_INF: + mpfr_set_inf (init_expr->value.complex.r, 1); + mpfr_set_inf (init_expr->value.complex.i, 1); + break; + + case GFC_INIT_REAL_NEG_INF: + mpfr_set_inf (init_expr->value.complex.r, -1); + mpfr_set_inf (init_expr->value.complex.i, -1); + break; + + case GFC_INIT_REAL_ZERO: + mpfr_set_ui (init_expr->value.complex.r, 0.0, GFC_RND_MODE); + mpfr_set_ui (init_expr->value.complex.i, 0.0, GFC_RND_MODE); + break; + + default: + gfc_free_expr (init_expr); + init_expr = NULL; + break; + } + break; + + case BT_LOGICAL: + if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE) + init_expr->value.logical = 0; + else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE) + init_expr->value.logical = 1; + else + { + gfc_free_expr (init_expr); + init_expr = NULL; + } + break; + + case BT_CHARACTER: + /* For characters, the length must be constant in order to + create a default initializer. */ + if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON + && sym->ts.cl->length + && sym->ts.cl->length->expr_type == EXPR_CONSTANT) + { + char_len = mpz_get_si (sym->ts.cl->length->value.integer); + init_expr->value.character.length = char_len; + init_expr->value.character.string = gfc_getmem (char_len+1); + ch = init_expr->value.character.string; + for (i = 0; i < char_len; i++) + *(ch++) = gfc_option.flag_init_character_value; + } + else + { + gfc_free_expr (init_expr); + init_expr = NULL; + } + break; + + default: + gfc_free_expr (init_expr); + init_expr = NULL; + } + return init_expr; +} + +/* Add an initialization expression to a local variable. */ +static void +apply_default_init_local (gfc_symbol *sym) +{ + gfc_expr *init = NULL; + + /* The symbol should be a variable or a function return value. */ + if ((sym->attr.flavor != FL_VARIABLE && !sym->attr.function) + || (sym->attr.function && sym->result != sym)) + return; + + /* Try to build the initializer expression. If we can't initialize + this symbol, then init will be NULL. */ + init = build_default_init_expr (sym); + if (init == NULL) + return; + + /* For saved variables, we don't want to add an initializer at + function entry, so we just add a static initializer. */ + if (sym->attr.save || sym->ns->save_all) + { + /* Don't clobber an existing initializer! */ + gcc_assert (sym->value == NULL); + sym->value = init; + return; + } + + build_init_assign (sym, init); +} /* Resolution of common features of flavors variable and procedure. */ @@ -6771,6 +6955,9 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) } } + if (sym->value == NULL && sym->attr.referenced) + apply_default_init_local (sym); /* Try to apply a default initialization. */ + /* Can the symbol have an initializer? */ flag = 0; if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3c6c9c82a8a..dd889ff6952 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2007-09-20 Asher Langton + + 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 PR c++/33460 diff --git a/gcc/testsuite/gfortran.dg/init_flag_1.f90 b/gcc/testsuite/gfortran.dg/init_flag_1.f90 new file mode 100644 index 00000000000..343d384ae3b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_1.f90 @@ -0,0 +1,57 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/init_flag_2.f90 b/gcc/testsuite/gfortran.dg/init_flag_2.f90 new file mode 100644 index 00000000000..c46cf1bd27f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_2.f90 @@ -0,0 +1,45 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/init_flag_3.f90 b/gcc/testsuite/gfortran.dg/init_flag_3.f90 new file mode 100644 index 00000000000..3cd9dc22e86 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_3.f90 @@ -0,0 +1,45 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/init_flag_4.f90 b/gcc/testsuite/gfortran.dg/init_flag_4.f90 new file mode 100644 index 00000000000..8ec40bc8fa5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_4.f90 @@ -0,0 +1,18 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/init_flag_5.f90 b/gcc/testsuite/gfortran.dg/init_flag_5.f90 new file mode 100644 index 00000000000..51dbd16cfba --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_5.f90 @@ -0,0 +1,18 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/init_flag_6.f90 b/gcc/testsuite/gfortran.dg/init_flag_6.f90 new file mode 100644 index 00000000000..45b05cd7d3c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_6.f90 @@ -0,0 +1,20 @@ +! { 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 + diff --git a/gcc/testsuite/gfortran.dg/init_flag_7.f90 b/gcc/testsuite/gfortran.dg/init_flag_7.f90 new file mode 100644 index 00000000000..78829811d95 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/init_flag_7.f90 @@ -0,0 +1,47 @@ +! { 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 -- 2.11.0