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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index daed721dbadfcbed50ad45ed6d1b1edbbd5313e9..fbab438a959cf069812248df76759e326ad3b9f4 100644 (file)
--- 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 2982e86bac043c5402369708397b7e710e401a69..bc27f664512636a5a29c88422ea73d1f156e3925 100644 (file)
--- 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 1837a53ddb8180b82dd75dfe3ae7b855e179769c..2cac42bad007ff72f8b360cf5ad75b2e766e7e43 100644 (file)
--- 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 85c1986a71b4f6cab9c135b0a1ceacb3b70568e0..797730c7a7a95469c04b23a05ec6c0fc3f3bb324 100644 (file)
--- 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 15c131ac86571e64da05e46ff93743e2c3ed4dc6..268d155a7967673caa090c3422fe69f19371f633 100644 (file)
--- 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 8ec5400ec95ae7f9440d6e62c17c6c187110305a..ef421d3b345c54acb74a8f56abd5404670fed872 100644 (file)
--- 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 348ca701c92d3547d70e6fdef03f36486c2c08f1..24131635713d9e580c7af7e9e4c781ffedb9aea6 100644 (file)
--- 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 4aa8303dfebd3368d1009ca209069c6a351e2a5b..13dfa88c7c7190c343c4d1460fb3aca9105d4f38 100644 (file)
--- 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 d78a2c07eecfd4a17f959810d426207d174e3b40..a89e834b7be44fe492d5b90433f5be7de68c96d8 100644 (file)
--- 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 9998302714a8beacf5b255daf82154cd434eedbc..7b068f91f2c1f5b7f87c3a6f9db2f8ebd5d582f6 100644 (file)
--- 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 1b94622bf4b3a48c1c8e5c47f5c9d1624c85c7d7..3026356d111fc8bbf2a3120e21fde040ad33b1d2 100644 (file)
--- 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);
 
@@ -941,6 +948,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 1bab5d5134a603ab56d25b88c410ce1442e8716a..407c4a1fdbc85202b56f6047332d31646865260e 100644 (file)
--- 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 09b6599c43a1249e43b1c76c2823c294d272b674..f387022069b86e5656d3dc27778459576bebfe99 100644 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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