aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFritz Reese <fritzoreese@gmail.com>2016-09-23 21:06:18 +0000
committerFritz Reese <foreese@gcc.gnu.org>2016-09-23 21:06:18 +0000
commit34d567d1f58df1e737c8abf6140ee8ec41e92377 (patch)
tree04238123ac677477e1192cb9ed0128ea5ec57ef4
parent6465652c8768dae2567f693eed04fb6a1b8ce517 (diff)
downloadgcc-34d567d1f58df1e737c8abf6140ee8ec41e92377.zip
gcc-34d567d1f58df1e737c8abf6140ee8ec41e92377.tar.gz
gcc-34d567d1f58df1e737c8abf6140ee8ec41e92377.tar.bz2
lang.opt, [...]: New flag -fdec-static.
2016-09-23 Fritz Reese <fritzoreese@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, dec_static_3.f90, dec_static_4.f90: New testcases. From-SVN: r240458
-rw-r--r--gcc/fortran/ChangeLog17
-rw-r--r--gcc/fortran/decl.c161
-rw-r--r--gcc/fortran/gfortran.h3
-rw-r--r--gcc/fortran/gfortran.texi52
-rw-r--r--gcc/fortran/invoke.texi9
-rw-r--r--gcc/fortran/lang.opt4
-rw-r--r--gcc/fortran/match.h2
-rw-r--r--gcc/fortran/options.c1
-rw-r--r--gcc/fortran/parse.c4
-rw-r--r--gcc/fortran/resolve.c18
-rw-r--r--gcc/fortran/symbol.c30
-rw-r--r--gcc/fortran/trans-decl.c2
-rw-r--r--gcc/testsuite/ChangeLog7
-rw-r--r--gcc/testsuite/gfortran.dg/dec_static_1.f9042
-rw-r--r--gcc/testsuite/gfortran.dg/dec_static_2.f9058
-rw-r--r--gcc/testsuite/gfortran.dg/dec_static_3.f9020
-rw-r--r--gcc/testsuite/gfortran.dg/dec_static_4.f9038
17 files changed, 452 insertions, 16 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index daed721..fbab438 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2016-09-23 Fritz Reese <fritzoreese@gmail.com>
+
+ * 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.
+
2016-09-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/48298
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2982e86..bc27f66 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3811,6 +3811,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 */
@@ -3874,6 +3875,14 @@ match_attr_spec (void)
d = DECL_ASYNCHRONOUS;
}
break;
+
+ case 'u':
+ if (match_string_p ("tomatic"))
+ {
+ /* Matched "automatic". */
+ d = DECL_AUTOMATIC;
+ }
+ break;
}
break;
@@ -4003,8 +4012,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':
@@ -4141,6 +4167,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;
@@ -4169,6 +4201,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
@@ -4307,10 +4351,15 @@ match_attr_spec (void)
&seen_at[d]);
break;
+ case DECL_STATIC:
case DECL_SAVE:
t = gfc_add_save (&current_attr, SAVE_EXPLICIT, NULL, &seen_at[d]);
break;
+ case DECL_AUTOMATIC:
+ t = gfc_add_automatic (&current_attr, NULL, &seen_at[d]);
+ break;
+
case DECL_TARGET:
t = gfc_add_target (&current_attr, &seen_at[d]);
break;
@@ -7785,6 +7834,114 @@ 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:
+ break;
+
+ 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 entity-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:
+ break;
+
+ 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 entity-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 1837a53..2cac42b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -736,7 +736,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
@@ -2816,6 +2816,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 85c1986..797730c 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
@@ -2421,6 +2422,56 @@ 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 DEC extended attributes
+@code{STATIC} and @code{AUTOMATIC} to provide explicit specification of entity
+storage. These follow the syntax of the Fortran standard @code{SAVE} attribute.
+
+@code{STATIC} is exactly equivalent to @code{SAVE}, and specifies that
+an entity should be allocated in static memory. As an example, @code{STATIC}
+local variables will retain their values across multiple calls to a function.
+
+Entities marked @code{AUTOMATIC} will be stack automatic whenever possible.
+@code{AUTOMATIC} is the default for local variables smaller than
+@option{-fmax-stack-var-size}, unless @option{-fno-automatic} is given. 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
@@ -2444,7 +2495,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..268d155 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 DEC-style STATIC and AUTOMATIC attributes to explicitly specify
+the storage of variables and other objects.
+
@item -fdollar-ok
@opindex @code{fdollar-ok}
@cindex @code{$}
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 8ec5400..ef421d3 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 DEC-style 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 d78a2c0..a89e834 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 9998302..7b068f9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11348,10 +11348,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);
@@ -11496,7 +11497,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 "
@@ -14319,7 +14320,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))
@@ -14471,7 +14472,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
@@ -14482,7 +14484,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 1b94622..3026356 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -382,7 +382,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";
@@ -447,6 +447,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)
{
@@ -488,6 +489,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);
@@ -942,6 +949,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)
{
@@ -1889,6 +1911,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))
@@ -4000,6 +4024,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 1bab5d5..407c4a1 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -660,7 +660,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/ChangeLog b/gcc/testsuite/ChangeLog
index 09b6599..f387022 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2016-09-23 Fritz Reese <fritzoreese@gmail.com>
+
+ * gfortran.dg/dec_static_1.f90: New.
+ * gfortran.dg/dec_static_2.f90: New.
+ * gfortran.dg/dec_static_3.f90: New.
+ * gfortran.dg/dec_static_4.f90: New.
+
2016-09-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/48298
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..7f319ec
--- /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
diff --git a/gcc/testsuite/gfortran.dg/dec_static_3.f90 b/gcc/testsuite/gfortran.dg/dec_static_3.f90
new file mode 100644
index 0000000..48b6220
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_static_3.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "" }
+!
+! Check errors for use of STATIC/AUTOMATIC without -fdec-static.
+!
+
+subroutine s()
+ implicit none
+ integer, automatic :: a ! { dg-error "is a DEC extension" }
+ integer, static :: b ! { dg-error "is a DEC extension" }
+ integer, save :: c
+
+ integer :: auto1, auto2, static1, static2, save1, save2
+ automatic auto1 ! { dg-error "is a DEC extension" }
+ automatic :: auto2 ! { dg-error "is a DEC extension" }
+ static static1 ! { dg-error "is a DEC extension" }
+ static :: static2 ! { dg-error "is a DEC extension" }
+ save save1
+ save :: save2
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/dec_static_4.f90 b/gcc/testsuite/gfortran.dg/dec_static_4.f90
new file mode 100644
index 0000000..91bed19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_static_4.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-options "-fdec-static" }
+!
+! Check for conflicts between STATIC/AUTOMATIC and other attributes.
+!
+
+function s(a, b, x, y) result(z)
+ implicit none
+ integer, automatic, intent(IN) :: a ! { dg-error "DUMMY attribute conflicts" }
+ integer, static, intent(IN) :: b ! { dg-error "DUMMY attribute conflicts" }
+ integer, intent(OUT) :: x, y
+ automatic :: x ! { dg-error "DUMMY attribute conflicts" }
+ static :: y ! { dg-error "DUMMY attribute conflicts" }
+
+ automatic ! { dg-error "Expected entity-list in AUTOMATIC statement" }
+ automatic :: ! { dg-error "Expected entity-list in AUTOMATIC statement" }
+ static ! { dg-error "Expected entity-list in STATIC statement" }
+ static :: ! { dg-error "Expected entity-list in STATIC statement" }
+
+ integer, automatic :: auto1, auto2
+ integer, static :: static1, static2
+ integer :: auto3, static3
+ automatic :: auto3
+ static :: static3
+
+ common /c1/ auto1, auto2 ! { dg-error "COMMON attribute conflicts" }
+ common /c2/ static1, static2 ! { dg-error "COMMON attribute conflicts" }
+ common /c3/ auto3, static3 ! { dg-error "COMMON attribute conflicts" }
+
+ integer, static :: z ! { dg-error "RESULT attribute conflicts" }
+ integer, automatic :: z ! { dg-error "RESULT attribute conflicts" }
+ static :: z ! { dg-error "RESULT attribute conflicts" }
+ automatic :: z ! { dg-error "RESULT attribute conflicts" }
+
+ integer, static, automatic :: o ! { dg-error "AUTOMATIC attribute conflicts" }
+
+ integer :: a, b, z ! fall-back decls so we don't get "no implicit type"
+end