* Re: Ping**2! Re: [PATCH, Fortran] Extension: AUTOMATIC/STATIC symbol attributes with -fdec-static
2016-09-07 13:53 ` Andre Vehreschild
@ 2016-09-07 20:20 ` Fritz Reese
0 siblings, 0 replies; 3+ messages in thread
From: Fritz Reese @ 2016-09-07 20:20 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 6250 bytes --]
On Wed, Sep 7, 2016 at 9:31 AM, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Fritz,
>
> please note: I do not have official review privileges. So my vote here
> is rather an advise to you and the official reviewers. Often such a
> inofficial review helps to speed things up, because the official ones
> are pointed to the nics and nacs and don't have to bother with the
> minor things.
Andre,
Thank you very much for your comments. I have only been contributing
to GNU/GCC for a year or two and appreciate the advice. I definitely
strive to keep my patches in line with the relevant standards and
style guides. Attached is a replacement for the original patch which
addresses your concerns.
> - Do I understand this correctly: AUTOMATIC and STATIC have to come last,
> i.e., right before the :: where declaring, e.g., a variable?
Not quite, you are probably misled by this code in decl.c:
> match
> gfc_match_static (void)
> {
...
> gfc_match (" ::");
(And equivalent for gfc_match_automatic.) These are similar to
gfc_match_save, and like gfc_match_save are only called to match
variable attribute specification _statements_, such as:
> SAVE :: x
> AUTOMATIC :: y
STATIC and AUTOMATIC are matched in any order in an attribute
specification _list_, as with SAVE, through the giant switch() earlier
in decl.c/match_attr_spec(). This applies to the following:
> INTEGER, SAVE, DIMENSION(3) :: x
> INTEGER, AUTOMATIC, DIMENSION(3) :: y
> - Running:
>
> $ contrib/check_GNU_style.sh dec_static.patch
>
> Reports some style issues in the C code, that should be fixed before
> commit. (Style in Fortran testcases does not matter that much.)
I was not aware of this script - thanks!
> Please change formatting in a separate patch or not at all (here!).
> This policy is to distinguish cosmetic changes from relevant ones.
Fixed. These changes are usually accidental - I try not to reformat
code that I'm not otherwise touching.
>> diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
...
>> +With @option{-fdec-static} GNU Fortran supports the explicit specification of
>> +two addition variable attributes: @code{STATIC} and @code{AUTOMATIC}. These
...
> But is it only for variables? Can't it be used for equivalences or
> other constructs, too?
Yes, good point, perhaps 'entities' is a better term here:
+With @option{-fdec-static} GNU Fortran supports the DEC extended attributes
+@code{STATIC} and @code{AUTOMATIC} to provide explicit specification of entity
+storage. [...]
>> diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
...
>> +@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.
>
> Well, this description to me sounds like: "Those attributes are
> useless, because they can be substituted." This is clearly not what you
> intend. I propose to include into the description that with "this
> switch the dec-extension" is available "to explicitly specify the
> storage of entities". Then the last sentence is still a good hint for
> all fortraneers that don't know the extension.
I guess I subconsciously made them sound "useless" because I hoped
users would think twice about using the extensions and use standard
conforming constructs instead. :-) But, maybe you are right and this
would be clearer:
+@item -fdec-static
+@opindex @code{fdec-static}
+Enable DEC-style STATIC and AUTOMATIC attributes to explicitly specify
+the storage of variables and other objects.
>> diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
...
>> +fdec-static
>> +Fortran Var(flag_dec_static)
>> +Enable STATIC and AUTOMATIC attributes.
>
> How about: Enable the dec-extension of STATIC and AUTOMATIC attributes.
> Just a proposal.
How about this, to match invoke.texi:
+fdec-static
+Fortran Var(flag_dec_static)
+Enable DEC-style STATIC and AUTOMATIC attributes.
> - Please add some testcases where the new error messages are tested.
Yes, good idea! cf. attached for dec_static_3.f90 and
dec_static_4.f90. These tests gave me a chance to realize I should
emit some better error messages so I made a minor change there:
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index db431dd..be8e9f7 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -7838,6 +7838,8 @@ gfc_match_automatic (void)
switch (m)
{
case MATCH_NO:
+ break;
+
case MATCH_ERROR:
return MATCH_ERROR;
@@ -7856,7 +7858,7 @@ gfc_match_automatic (void)
if (!seen_symbol)
{
- gfc_error ("Expected var-list in AUTOMATIC statement at %C");
+ gfc_error ("Expected entity-list in AUTOMATIC statement at %C");
return MATCH_ERROR;
}
... And similar for gfc_match_static. (Nb. "entity-list" was chosen to
correspond with the "save-entity-list" descriptor used by F90 to
specify the SAVE statement.)
Andre, thanks again for your comments. I hope the attached patch is
acceptable for trunk; now pending official review once again.
---
Fritz Reese
2016-09-07 Fritz Reese <fritzoreese@gmail.com>
Support for AUTOMATIC and STATIC attributes with new flag -fdec-static.
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.
[-- Attachment #2: dec_static2.patch --]
[-- Type: text/x-patch, Size: 24244 bytes --]
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index ce5ebb7..be8e9f7 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,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 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..44b6041 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
@@ -2420,6 +2421,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
@@ -2443,7 +2494,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 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..d822f05 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..0ae957e 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..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
^ permalink raw reply [flat|nested] 3+ messages in thread