* DEC Extension Patches: [4] AUTOMATIC and STATIC attributes
@ 2016-04-12 23:23 Fritz Reese
0 siblings, 0 replies; only message in thread
From: Fritz Reese @ 2016-04-12 23:23 UTC (permalink / raw)
To: fortran
[-- Attachment #1: Type: text/plain, Size: 1174 bytes --]
All,
Attached is another DEC extension. For convenience, this patch is
based on previous DEC extension patches. That way when the other DEC
extensions are merged in the next release, this patch can be merged on
top of them. Therefore it depends on the four patches posted
previously:
[0] gfc_dt_upper_string/gfc_dt_lower_string
https://gcc.gnu.org/ml/fortran/2016-03/msg00003.html
[1] resolve_component
https://gcc.gnu.org/ml/fortran/2016-03/msg00004.html
[2] check_component
https://gcc.gnu.org/ml/fortran/2016-03/msg00005.html
[3] STRUCTURE and UNION
https://gcc.gnu.org/ml/fortran/2016-03/msg00006.html
Attached: [4] AUTOMATIC and STATIC attributes. (Upon request an
independent patch can be submitted based directly on trunk.)
This patch introduces two new variable attributes: AUTOMATIC and
STATIC: STATIC is an alias for SAVE. AUTOMATIC explicitly requests a
variable to be placed on the stack. Support for these attributes is
only enabled with a new compile flag -fdec-static. This new flag is
also enabled with -fdec, introduced in the STRUCTURE/UNION patch. For
more details on the implementation see the patch and the updated
gfortran manual.
---
Fritz Reese
[-- Attachment #2: 0001-Support-for-AUTOMATIC-and-STATIC-attributes-with-new.patch --]
[-- Type: application/octet-stream, Size: 24975 bytes --]
From f54232ba687144cc96505d7075e09d80b8e685a5 Mon Sep 17 00:00:00 2001
From: Fritz O. Reese <fritzoreese@gmail.com>
Date: Mon, 11 Apr 2016 15:19:46 -0400
Subject: [PATCH 1/2] 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_01.f90, dec_static_02.f90: New testcases.
---
gcc/fortran/decl.c | 157 +++++++++++++++++++++++++++-
gcc/fortran/gfortran.h | 3 +-
gcc/fortran/gfortran.texi | 50 +++++++++-
gcc/fortran/invoke.texi | 10 ++-
gcc/fortran/lang.opt | 4 +
gcc/fortran/match.h | 2 +
gcc/fortran/options.c | 1 +
gcc/fortran/parse.c | 4 +
gcc/fortran/resolve.c | 18 ++--
gcc/fortran/symbol.c | 30 +++++-
gcc/fortran/trans-decl.c | 2 +-
gcc/testsuite/gfortran.dg/dec_static_1.for | 42 ++++++++
gcc/testsuite/gfortran.dg/dec_static_2.for | 60 +++++++++++
13 files changed, 366 insertions(+), 17 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_static_1.for
create mode 100644 gcc/testsuite/gfortran.dg/dec_static_2.for
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0b8787a..87b2cd5 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3824,6 +3824,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 */
@@ -3887,6 +3888,14 @@ match_attr_spec (void)
d = DECL_ASYNCHRONOUS;
}
break;
+
+ case 'u':
+ if (match_string_p ("tomatic"))
+ {
+ /* Matched "automatic". */
+ d = DECL_AUTOMATIC;
+ }
+ break;
}
break;
@@ -4015,8 +4024,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':
@@ -4153,6 +4179,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;
@@ -4181,6 +4213,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
@@ -4319,10 +4363,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;
@@ -7756,6 +7805,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 0bb71cb..37aa89f 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
@@ -2802,6 +2802,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 d1617c1..b110e58 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1461,6 +1461,7 @@ without warning.
* Read/Write after EOF marker::
* STRUCTURE and RECORD::
* UNION and MAP::
+* AUTOMATIC and STATIC attributes::
@end menu
@node Old-style kind specifications
@@ -2119,7 +2120,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}
@@ -2375,6 +2375,53 @@ a.rx = z'AABBCCCCFFFFFFFF'
! a.l == z'AA'
@end example
+@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
@@ -2398,7 +2445,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 e8b8409..d592d15 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -115,8 +115,8 @@ by type. Explanations are in the following sections.
@item Fortran Language Options
@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 -fdefault-double-8 -fdefault-integer-8 @gol
+-fd-lines-as-comments -fdefault-double-8 -fdefault-integer-8 @gol
+-fdec -fdec-structure -fdec-static @gol
-fdefault-real-8 -fdollar-ok -ffixed-line-length-@var{n} @gol
-ffixed-line-length-none -ffree-form -ffree-line-length-@var{n} @gol
-ffree-line-length-none -fimplicit-none -finteger-4-integer-8 @gol
@@ -239,6 +239,7 @@ full documentation.
Other flags enabled by this switch are:
@option{-fdollar-ok} @option{-fcray-pointer} @option{-fdec-structure}
+@option{-fdec-static}
@item -fdec-structure
@opindex @code{fdec-structure}
@@ -247,6 +248,11 @@ Enable DEC @code{STRUCTURE} and @code{RECORD} as well as @code{UNION},
provided for compatibility only; Fortran 90 derived types should be used
instead where possible.
+@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 bdf5fa5..71c2bce 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -424,6 +424,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 5a91ec1..d57d095 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -53,6 +53,7 @@ static void
set_dec_flags (int value)
{
gfc_option.flag_dec_structure = value;
+ flag_dec_static = value;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index dd7aa6a..d8b0081 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 2c68af2..e841c91 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11312,10 +11312,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);
@@ -11460,7 +11461,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 "
@@ -14236,7 +14237,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))
@@ -14388,7 +14389,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
@@ -14399,7 +14401,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 0ee7dec..cd668be 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))
@@ -3987,6 +4011,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 d4ea6c8..0dc0b3e 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -646,7 +646,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.for b/gcc/testsuite/gfortran.dg/dec_static_1.for
new file mode 100644
index 0000000..47ce3c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_static_1.for
@@ -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.for b/gcc/testsuite/gfortran.dg/dec_static_2.for
new file mode 100644
index 0000000..dc5f699
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_static_2.for
@@ -0,0 +1,60 @@
+ ! { 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.
+ !
+ 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
--
1.7.1
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2016-04-12 23:23 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-04-12 23:23 DEC Extension Patches: [4] AUTOMATIC and STATIC attributes Fritz Reese
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).