https://gcc.gnu.org/ml/fortran/2016-08/msg00077.html
Minor correction to the previously submitted patch:
On Wed, Aug 17, 2016 at 7:20 AM, Fritz Reese <fritzore...@gmail.com> wrote:
> ...
> Note that AUTOMATIC does NOT override -fno-automatic; with the flag, a
> warning is produced for variables marked AUTOMATIC.
> ...
This statement was true for a previous version of this patch, but I
had changed the behavior and this is now incorrect. AUTOMATIC
attributes _do_ override -fno-automatic. I also submitted a slightly
older version of the patch file, which contained two errors. This
re-submission fixes these two artifacts; (1) Rename dec_static_*.for
-> dec_static-*.f90; and (2) fix a comment in the second test case:
--- a/gcc/testsuite/gfortran.dg/dec_static_2.f90
+++ b/gcc/testsuite/gfortran.dg/dec_static_2.f90
@@ -1,9 +1,7 @@
! { dg-do run }
! { dg-options "-fdec-static -fno-automatic -finit-local-zero" }
!
-! Make sure a warning is produced when variables marked AUTOMATIC
-! cannot be automatic due to compilation with -fno-automatic, and
-! that they are in fact still saved.
+! Test STATIC and AUTOMATIC with -fno-automatic and recursive subroutines.
!
The attached patch is the CORRECT version that I intend to commit.
Sorry for the mixup.
> Bootstraps and regtests on x86_64-redhat-linux. Questions, comments,
> and critique welcome. Ok for trunk?
---
Fritz Reese
> 08-17-2016 Fritz Reese <fritzore...@gmail.com>
>
> gcc/fortran/
> * lang.opt, invoke.texi, gfortran.texi: New flag -fdec-static.
> * options.c (set_dec_flags): Set -fdec-static with -fdec.
> * gfortran.h (symbol_attribute): New attribute AUTOMATIC.
> * gfortran.h (gfc_add_automatic): New prototype.
> * match.h (gfc_match_automatic, gfc_match_static): New functions.
> * decl.c (gfc_match_automatic, gfc_match_static): Ditto.
> * symbol.c (gfc_add_automatic): Ditto.
> * decl.c (match_attr_spec): Match AUTOMATIC and STATIC decls.
> * parse.c (decode_specification_statement, decode_statement): Ditto.
> * resolve.c (apply_default_init_local, resolve_fl_variable_derived,
> resolve_symbol): Support for automatic attribute.
> * symbol.c (check_conflict, gfc_copy_attr, gfc_is_var_automatic):
> Ditto.
> * trans-decl.c (gfc_finish_var_decl): Ditto.
>
> gcc/testsuite/gfortran.dg/
> * dec_static_1.f90, dec_static_2.f90: New testcases.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index ce5ebb7..db431dd 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3794,6 +3794,7 @@ match_attr_spec (void)
DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE,
+ DECL_STATIC, DECL_AUTOMATIC,
DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE,
DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_CONTIGUOUS,
DECL_NONE, GFC_DECL_END /* Sentinel */
@@ -3857,6 +3858,14 @@ match_attr_spec (void)
d = DECL_ASYNCHRONOUS;
}
break;
+
+ case 'u':
+ if (match_string_p ("tomatic"))
+ {
+ /* Matched "automatic". */
+ d = DECL_AUTOMATIC;
+ }
+ break;
}
break;
@@ -3986,8 +3995,25 @@ match_attr_spec (void)
break;
case 's':
- if (match_string_p ("save"))
- d = DECL_SAVE;
+ gfc_next_ascii_char ();
+ switch (gfc_next_ascii_char ())
+ {
+ case 'a':
+ if (match_string_p ("ve"))
+ {
+ /* Matched "save". */
+ d = DECL_SAVE;
+ }
+ break;
+
+ case 't':
+ if (match_string_p ("atic"))
+ {
+ /* Matched "static". */
+ d = DECL_STATIC;
+ }
+ break;
+ }
break;
case 't':
@@ -4124,6 +4150,12 @@ match_attr_spec (void)
case DECL_SAVE:
attr = "SAVE";
break;
+ case DECL_STATIC:
+ attr = "STATIC";
+ break;
+ case DECL_AUTOMATIC:
+ attr = "AUTOMATIC";
+ break;
case DECL_TARGET:
attr = "TARGET";
break;
@@ -4152,6 +4184,18 @@ match_attr_spec (void)
if (seen[d] == 0)
continue;
+ if ((d == DECL_STATIC || d == DECL_AUTOMATIC)
+ && !flag_dec_static)
+ {
+ gfc_error ("%s at %L is a DEC extension, enable with -fdec-static",
+ d == DECL_STATIC ? "STATIC" : "AUTOMATIC", &seen_at[d]);
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+ /* Allow SAVE with STATIC, but don't complain. */
+ if (d == DECL_STATIC && seen[DECL_SAVE])
+ continue;
+
if (gfc_current_state () == COMP_DERIVED
&& d != DECL_DIMENSION && d != DECL_CODIMENSION
&& d != DECL_POINTER && d != DECL_PRIVATE
@@ -4290,10 +4334,15 @@ match_attr_spec (void)
&seen_at[d]);
break;
+ case DECL_STATIC:
case DECL_SAVE:
t = gfc_add_save (¤t_attr, SAVE_EXPLICIT, NULL, &seen_at[d]);
break;
+ case DECL_AUTOMATIC:
+ t = gfc_add_automatic (¤t_attr, NULL, &seen_at[d]);
+ break;
+
case DECL_TARGET:
t = gfc_add_target (¤t_attr, &seen_at[d]);
break;
@@ -7767,6 +7816,110 @@ gfc_match_parameter (void)
}
+match
+gfc_match_automatic (void)
+{
+ gfc_symbol *sym;
+ match m;
+ bool seen_symbol = false;
+
+ if (!flag_dec_static)
+ {
+ gfc_error ("AUTOMATIC at %C is a DEC extension, enable with "
+ "-fdec-static");
+ return MATCH_ERROR;
+ }
+
+ gfc_match (" ::");
+
+ for (;;)
+ {
+ m = gfc_match_symbol (&sym, 0);
+ switch (m)
+ {
+ case MATCH_NO:
+ case MATCH_ERROR:
+ return MATCH_ERROR;
+
+ case MATCH_YES:
+ if (!gfc_add_automatic (&sym->attr, sym->name, &gfc_current_locus))
+ return MATCH_ERROR;
+ seen_symbol = true;
+ break;
+ }
+
+ if (gfc_match_eos () == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ if (!seen_symbol)
+ {
+ gfc_error ("Expected var-list in AUTOMATIC statement at %C");
+ return MATCH_ERROR;
+ }
+
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in AUTOMATIC statement at %C");
+ return MATCH_ERROR;
+}
+
+
+match
+gfc_match_static (void)
+{
+ gfc_symbol *sym;
+ match m;
+ bool seen_symbol = false;
+
+ if (!flag_dec_static)
+ {
+ gfc_error ("STATIC at %C is a DEC extension, enable with -fdec-static");
+ return MATCH_ERROR;
+ }
+
+ gfc_match (" ::");
+
+ for (;;)
+ {
+ m = gfc_match_symbol (&sym, 0);
+ switch (m)
+ {
+ case MATCH_NO:
+ case MATCH_ERROR:
+ return MATCH_ERROR;
+
+ case MATCH_YES:
+ if (!gfc_add_save (&sym->attr, SAVE_EXPLICIT, sym->name,
+ &gfc_current_locus))
+ return MATCH_ERROR;
+ seen_symbol = true;
+ break;
+ }
+
+ if (gfc_match_eos () == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ if (!seen_symbol)
+ {
+ gfc_error ("Expected var-list in STATIC statement at %C");
+ return MATCH_ERROR;
+ }
+
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in STATIC statement at %C");
+ return MATCH_ERROR;
+}
+
+
/* Save statements have a special syntax. */
match
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 813f7d9..2e30994 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -726,7 +726,7 @@ typedef struct
optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
- contiguous:1, fe_temp: 1;
+ contiguous:1, fe_temp: 1, automatic: 1;
/* For CLASS containers, the pointer attribute is sometimes set internally
even though it was not directly specified. In this case, keep the
@@ -2803,6 +2803,7 @@ bool gfc_add_cray_pointee (symbol_attribute *, locus *);
match gfc_mod_pointee_as (gfc_array_spec *);
bool gfc_add_protected (symbol_attribute *, const char *, locus *);
bool gfc_add_result (symbol_attribute *, const char *, locus *);
+bool gfc_add_automatic (symbol_attribute *, const char *, locus *);
bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *);
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index b34ae86..a0cf78b 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1462,6 +1462,7 @@ without warning.
* STRUCTURE and RECORD::
* UNION and MAP::
* Type variants for integer intrinsics::
+* AUTOMATIC and STATIC attributes::
@end menu
@node Old-style kind specifications
@@ -2120,7 +2121,6 @@ consider @code{BACKSPACE} or @code{REWIND} to properly position
the file before the EOF marker. As an extension, the run-time error may
be disabled using -std=legacy.
-
@node STRUCTURE and RECORD
@subsection @code{STRUCTURE} and @code{RECORD}
@cindex @code{STRUCTURE}
@@ -2420,6 +2420,53 @@ here:
@tab @code{--} @tab @code{FLOATI} @tab @code{FLOATJ} @tab @code{FLOATK}
@end multitable
+@node AUTOMATIC and STATIC attributes
+@subsection @code{AUTOMATIC} and @code{STATIC} attributes
+@cindex variable attributes
+@cindex @code{AUTOMATIC}
+@cindex @code{STATIC}
+
+With @option{-fdec-static} GNU Fortran supports the explicit specification of
+two addition variable attributes: @code{STATIC} and @code{AUTOMATIC}. These
+follow the syntax of the @code{SAVE} attribute.
+
+@code{STATIC} is exactly equivalent to @code{SAVE}.
+
+@code{AUTOMATIC} is the default for local variables smaller than
+@option{-fmax-stack-var-size}, unless @option{-fno-automatic} is given.
+Variables marked @code{AUTOMATIC} will be stack automatic variables whenever
+possible. This attribute overrides @option{-fno-automatic},
+@option{-fmax-stack-var-size}, and blanket @code{SAVE} statements.
+
+Examples:
+
+
+@example
+subroutine f
+ integer, automatic :: i ! automatic variable
+ integer x, y ! static variables
+ save
+ ...
+endsubroutine
+@end example
+@example
+subroutine f
+ integer a, b, c, x, y, z
+ static :: x
+ save y
+ automatic z, c
+ ! a, b, c, and z are automatic
+ ! x and y are static
+endsubroutine
+@end example
+@example
+! Compiled with -fno-automatic
+subroutine f
+ integer a, b, c, d
+ automatic :: a
+ ! a is automatic; b, c, and d are static
+endsubroutine
+@end example
@node Extensions not implemented in GNU Fortran
@section Extensions not implemented in GNU Fortran
@@ -2443,7 +2490,6 @@ code that uses them running with the GNU Fortran compiler.
* ENCODE and DECODE statements::
* Variable FORMAT expressions::
@c * Q edit descriptor::
-@c * AUTOMATIC statement::
@c * TYPE and ACCEPT I/O Statements::
@c * .XOR. operator::
@c * CARRIAGECONTROL, DEFAULTFILE, DISPOSE and RECORDTYPE I/O specifiers::
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 15c131a..a5da59e 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -116,7 +116,7 @@ by type. Explanations are in the following sections.
@xref{Fortran Dialect Options,,Options controlling Fortran dialect}.
@gccoptlist{-fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code @gol
-fd-lines-as-comments @gol
--fdec -fdec-structure -fdec-intrinsic-ints @gol
+-fdec -fdec-structure -fdec-intrinsic-ints -fdec-static @gol
-fdefault-double-8 -fdefault-integer-8 @gol
-fdefault-real-8 -fdollar-ok -ffixed-line-length-@var{n} @gol
-ffixed-line-length-none -ffree-form -ffree-line-length-@var{n} @gol
@@ -241,7 +241,7 @@ full documentation.
Other flags enabled by this switch are:
@option{-fdollar-ok} @option{-fcray-pointer} @option{-fdec-structure}
-@option{-fdec-intrinsic-ints}
+@option{-fdec-intrinsic-ints} @option{-fdec-static}
@item -fdec-structure
@opindex @code{fdec-structure}
@@ -255,6 +255,11 @@ instead where possible.
Enable B/I/J/K kind variants of existing integer functions (e.g. BIAND, IIAND,
JIAND, etc...). For a complete list of intrinsics see the full documentation.
+@item -fdec-static
+@opindex @code{fdec-static}
+Enable STATIC and AUTOMATIC as attributes specifying storage location.
+STATIC is equivalent to SAVE, and locals are typically AUTOMATIC by default.
+
@item -fdollar-ok
@opindex @code{fdollar-ok}
@cindex @code{$}
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 8ec5400..260512d 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -432,6 +432,10 @@ fdec-structure
Fortran
Enable support for DEC STRUCTURE/RECORD.
+fdec-static
+Fortran Var(flag_dec_static)
+Enable STATIC and AUTOMATIC attributes.
+
fdefault-double-8
Fortran Var(flag_default_double)
Set the default double precision kind to an 8 byte wide type.
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 348ca70..2413163 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -223,6 +223,7 @@ void gfc_set_constant_character_len (int, gfc_expr *, int);
/* Matchers for attribute declarations. */
match gfc_match_allocatable (void);
match gfc_match_asynchronous (void);
+match gfc_match_automatic (void);
match gfc_match_codimension (void);
match gfc_match_contiguous (void);
match gfc_match_dimension (void);
@@ -238,6 +239,7 @@ match gfc_match_protected (void);
match gfc_match_private (gfc_statement *);
match gfc_match_public (gfc_statement *);
match gfc_match_save (void);
+match gfc_match_static (void);
match gfc_match_modproc (void);
match gfc_match_target (void);
match gfc_match_value (void);
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 4aa8303..13dfa88 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -54,6 +54,7 @@ set_dec_flags (int value)
{
gfc_option.flag_dec_structure = value;
flag_dec_intrinsic_ints = value;
+ flag_dec_static = value;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index bd7b138..4d684f6 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -191,6 +191,7 @@ decode_specification_statement (void)
ST_INTERFACE);
match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
+ match ("automatic", gfc_match_automatic, ST_ATTR_DECL);
break;
case 'b':
@@ -256,6 +257,7 @@ decode_specification_statement (void)
case 's':
match ("save", gfc_match_save, ST_ATTR_DECL);
+ match ("static", gfc_match_static, ST_ATTR_DECL);
match ("structure", gfc_match_structure_decl, ST_STRUCTURE_DECL);
break;
@@ -436,6 +438,7 @@ decode_statement (void)
match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT);
match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
+ match ("automatic", gfc_match_automatic, ST_ATTR_DECL);
break;
case 'b':
@@ -548,6 +551,7 @@ decode_statement (void)
match ("sequence", gfc_match_eos, ST_SEQUENCE);
match ("stop", gfc_match_stop, ST_STOP);
match ("save", gfc_match_save, ST_ATTR_DECL);
+ match ("static", gfc_match_static, ST_ATTR_DECL);
match ("submodule", gfc_match_submodule, ST_SUBMODULE);
match ("sync all", gfc_match_sync_all, ST_SYNC_ALL);
match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7763f9c..8780ac3 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11237,10 +11237,11 @@ apply_default_init_local (gfc_symbol *sym)
entry, so we just add a static initializer. Note that automatic variables
are stack allocated even with -fno-automatic; we have also to exclude
result variable, which are also nonstatic. */
- if (sym->attr.save || sym->ns->save_all
- || (flag_max_stack_var_size == 0 && !sym->attr.result
- && (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive)
- && (!sym->attr.dimension || !is_non_constant_shape_array (sym))))
+ if (!sym->attr.automatic
+ && (sym->attr.save || sym->ns->save_all
+ || (flag_max_stack_var_size == 0 && !sym->attr.result
+ && (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive)
+ && (!sym->attr.dimension || !is_non_constant_shape_array (sym)))))
{
/* Don't clobber an existing initializer! */
gcc_assert (sym->value == NULL);
@@ -11385,7 +11386,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
a hidden default for allocatable components. */
if (!(sym->value || no_init_flag) && sym->ns->proc_name
&& sym->ns->proc_name->attr.flavor == FL_MODULE
- && !sym->ns->save_all && !sym->attr.save
+ && !(sym->ns->save_all && !sym->attr.automatic) && !sym->attr.save
&& !sym->attr.pointer && !sym->attr.allocatable
&& gfc_has_default_initializer (sym->ts.u.derived)
&& !gfc_notify_std (GFC_STD_F2008, "Implied SAVE for module variable "
@@ -14159,7 +14160,7 @@ resolve_symbol (gfc_symbol *sym)
if (class_attr.codimension
&& !(class_attr.allocatable || sym->attr.dummy || sym->attr.save
|| sym->attr.select_type_temporary
- || sym->ns->save_all
+ || (sym->ns->save_all && !sym->attr.automatic)
|| sym->ns->proc_name->attr.flavor == FL_MODULE
|| sym->ns->proc_name->attr.is_main_program
|| sym->attr.function || sym->attr.result || sym->attr.use_assoc))
@@ -14311,7 +14312,8 @@ resolve_symbol (gfc_symbol *sym)
}
/* Check threadprivate restrictions. */
- if (sym->attr.threadprivate && !sym->attr.save && !sym->ns->save_all
+ if (sym->attr.threadprivate && !sym->attr.save
+ && !(sym->ns->save_all && !sym->attr.automatic)
&& (!sym->attr.in_common
&& sym->module == NULL
&& (sym->ns->proc_name == NULL
@@ -14322,7 +14324,7 @@ resolve_symbol (gfc_symbol *sym)
if (sym->attr.omp_declare_target
&& sym->attr.flavor == FL_VARIABLE
&& !sym->attr.save
- && !sym->ns->save_all
+ && !(sym->ns->save_all && !sym->attr.automatic)
&& (!sym->attr.in_common
&& sym->module == NULL
&& (sym->ns->proc_name == NULL
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c967f25..f47aff3 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -373,7 +373,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
*is_bind_c = "BIND(C)", *procedure = "PROCEDURE",
*proc_pointer = "PROCEDURE POINTER", *abstract = "ABSTRACT",
*asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION",
- *contiguous = "CONTIGUOUS", *generic = "GENERIC";
+ *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC";
static const char *threadprivate = "THREADPRIVATE";
static const char *omp_declare_target = "OMP DECLARE TARGET";
static const char *oacc_declare_copyin = "OACC DECLARE COPYIN";
@@ -438,6 +438,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (dummy, save);
conf (in_common, save);
conf (result, save);
+ conf (automatic, save);
switch (attr->flavor)
{
@@ -479,6 +480,12 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (pointer, codimension);
conf (allocatable, elemental);
+ conf (in_common, automatic);
+ conf (in_equivalence, automatic);
+ conf (result, automatic);
+ conf (use_assoc, automatic);
+ conf (dummy, automatic);
+
conf (target, external);
conf (target, intrinsic);
@@ -933,6 +940,21 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where)
bool
+gfc_add_automatic (symbol_attribute *attr, const char *name, locus *where)
+{
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->automatic && !gfc_notify_std (GFC_STD_LEGACY,
+ "Duplicate AUTOMATIC attribute specified at %L", where))
+ return false;
+
+ attr->automatic = 1;
+ return check_conflict (attr, name, where);
+}
+
+
+bool
gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where)
{
@@ -1880,6 +1902,8 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
if (src->allocatable && !gfc_add_allocatable (dest, where))
goto fail;
+ if (src->automatic && !gfc_add_automatic (dest, NULL, where))
+ goto fail;
if (src->dimension && !gfc_add_dimension (dest, NULL, where))
goto fail;
if (src->codimension && !gfc_add_codimension (dest, NULL, where))
@@ -3991,6 +4015,10 @@ gfc_is_var_automatic (gfc_symbol *sym)
&& sym->ts.u.cl
&& !gfc_is_constant_expr (sym->ts.u.cl->length))
return true;
+ /* Variables with explicit AUTOMATIC attribute. */
+ if (sym->attr.automatic)
+ return true;
+
return false;
}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 6cf7f57..05fa877 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -647,7 +647,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
}
/* Keep variables larger than max-stack-var-size off stack. */
- if (!sym->ns->proc_name->attr.recursive
+ if (!sym->ns->proc_name->attr.recursive && !sym->attr.automatic
&& INTEGER_CST_P (DECL_SIZE_UNIT (decl))
&& !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
/* Put variable length auto array pointers always into stack. */
diff --git a/gcc/testsuite/gfortran.dg/dec_static_1.f90 b/gcc/testsuite/gfortran.dg/dec_static_1.f90
new file mode 100644
index 0000000..4dcfc7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_static_1.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-options "-fdec-static -finit-local-zero" }
+!
+! Test AUTOMATIC and STATIC attributes.
+!
+subroutine assert(s, i1, i2)
+ implicit none
+ integer, intent(in) :: i1, i2
+ character(*), intent(in) :: s
+ if (i1 .ne. i2) then
+ print *, s, ": expected ", i2, " but was ", i1
+ call abort
+ endif
+endsubroutine assert
+
+function f (x, y)
+ implicit none
+ integer f
+ integer, intent(in) :: x, y
+ integer :: a ! only a can actually be saved
+ integer, automatic :: c ! should actually be automatic
+ save
+
+ ! a should be incremented by x every time and saved
+ a = a + x
+ f = a
+
+ ! c should be zeroed every time, therefore equal y
+ c = c + y
+ call assert ("f%c", c, y)
+ return
+endfunction
+
+implicit none
+integer :: f
+
+! Should return static value of a; accumulates x
+call assert ("f()", f(1,3), 1)
+call assert ("f()", f(1,4), 2)
+call assert ("f()", f(1,2), 3)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_static_2.f90 b/gcc/testsuite/gfortran.dg/dec_static_2.f90
new file mode 100644
index 0000000..392f342
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_static_2.f90
@@ -0,0 +1,58 @@
+! { dg-do run }
+! { dg-options "-fdec-static -fno-automatic -finit-local-zero" }
+!
+! Test STATIC and AUTOMATIC with -fno-automatic and recursive subroutines.
+!
+subroutine assert(s, i1, i2)
+ implicit none
+ integer, intent(in) :: i1, i2
+ character(*), intent(in) :: s
+ if (i1 .ne. i2) then
+ print *, s, ": expected ", i2, " but was ", i1
+ call abort
+ endif
+endsubroutine
+
+function f (x)
+implicit none
+ integer f
+ integer, intent(in) :: x
+ integer, static :: a ! should be SAVEd
+ a = a + x ! should increment by x every time
+ f = a
+ return
+endfunction
+
+recursive subroutine g (x)
+implicit none
+ integer, intent(in) :: x
+ integer, automatic :: a ! should be automatic (in recursive)
+ a = a + x ! should be set to x every time
+ call assert ("g%a", a, x)
+endsubroutine
+
+subroutine h (x)
+implicit none
+ integer, intent(in) :: x
+ integer, automatic :: a ! should be automatic (outside recursive)
+ a = a + x ! should be set to x every time
+ call assert ("h%a", a, x)
+endsubroutine
+
+implicit none
+integer :: f
+
+! Should return static value of c; accumulates x
+call assert ("f()", f(3), 3)
+call assert ("f()", f(4), 7)
+call assert ("f()", f(2), 9)
+
+call g(3)
+call g(4)
+call g(2)
+
+call h(3)
+call h(4)
+call h(2)
+
+end
