procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/20441 (-finit-local-zero is missing from gfortran)

Browse source 
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.

From-SVN: r128643
This commit is contained in:
Asher Langton 2007-09-21 02:34:14 +00:00 • committed by Asher Langton
parent 819fec0023
commit 51b09ce3d9
14 changed files with 624 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
gcc/fortran/ChangeLog
View file

@ -1,3 +1,20 @@
2007-09-20 Asher Langton <langton2@llnl.gov>
PR fortran/20441
* gfortran.h : Add init_local_* enums and init_flag_* flags to
gfc_option_t.
* lang.opt: Add -finit-local-zero, -finit-real, -finit-integer,
-finit-character, and -finit-logical flags.
* invoke.texi: Document new options.
* resolve.c (build_init_assign): New function.
(apply_init_assign): Move part of function into build_init_assign.
(build_default_init_expr): Build local initializer (-finit-*).
(apply_default_init_local): Apply local initializer (-finit-*).
(resolve_fl_variable): Try to add local initializer (-finit-*).
* options.c (gfc_init_options, gfc_handle_option,
gfc_post_options): Handle -finit-local-zero, -finit-real,
-finit-integer, -finit-character, and -finit-logical flags.
2007-09-20 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33221

39
gcc/fortran/gfortran.h
View file

@ -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;

31
gcc/fortran/invoke.texi
View file

@ -156,7 +156,9 @@ and warnings}.
-fsecond-underscore @gol
-fbounds-check -fmax-stack-var-size=@var{n} @gol
-fpack-derived -frepack-arrays -fshort-enums -fexternal-blas @gol
-fblas-matmul-limit=@var{n} -frecursive}
-fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol
-finit-integer=@var{n} -finit-real=@var{<zero|inf|-inf|nan>} @gol
-finit-logical=@var{<true|false>} -finit-character=@var{n}}
@end table
@menu
@ -931,6 +933,33 @@ Allow indirect recursion by forcing all local arrays to be allocated
on the stack. This flag cannot be used together with
@option{-fmax-stack-var-size=} or @option{-fno-automatic}.
@item -finit-local-zero
@item -finit-integer=@var{n}
@item -finit-real=@var{<zero|inf|-inf|nan>}
@item -finit-logical=@var{<true|false>}
@item -finit-character=@var{n}
@opindex @code{finit-local-zero}
@opindex @code{finit-integer}
@opindex @code{finit-real}
@opindex @code{finit-logical}
@opindex @code{finit-character}
The @option{-finit-local-zero} option instructs the compiler to
initialize local @code{INTEGER}, @code{REAL}, and @code{COMPLEX}
variables to zero, @code{LOGICAL} variables to false, and
@code{CHARACTER} variables to a string of null bytes. Finer-grained
initialization options are provided by the
@option{-finit-integer=@var{n}},
@option{-finit-real=@var{<zero|inf|-inf|nan>}} (which also initializes
the real and imaginary parts of local @code{COMPLEX} variables),
@option{-finit-logical=@var{<true|false>}}, and
@option{-finit-character=@var{n}} (where @var{n} is an ASCII character
value) options. These options do not initialize components of derived
type variables, nor do they initialize variables that appear in an
@code{EQUIVALENCE} statement. (This limitation may be removed in
future releases).
Note that the @option{-finit-real=nan} option initializes @code{REAL}
and @code{COMPLEX} variables with a quiet NaN.
@end table
@xref{Code Gen Options,,Options for Code Generation Conventions,

20
gcc/fortran/lang.opt
View file

@ -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

57
gcc/fortran/options.c
View file

@ -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;

215
gcc/fortran/resolve.c
View file

@ -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

11
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,14 @@
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

57
gcc/testsuite/gfortran.dg/init_flag_1.f90 Normal file
View file

@ -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

45
gcc/testsuite/gfortran.dg/init_flag_2.f90 Normal file
View file

@ -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

45
gcc/testsuite/gfortran.dg/init_flag_3.f90 Normal file
View file

@ -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

18
gcc/testsuite/gfortran.dg/init_flag_4.f90 Normal file
View file

@ -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

18
gcc/testsuite/gfortran.dg/init_flag_5.f90 Normal file
View file

@ -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

20
gcc/testsuite/gfortran.dg/init_flag_6.f90 Normal file
View file

@ -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

47
gcc/testsuite/gfortran.dg/init_flag_7.f90 Normal file
View file

@ -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