Hi all, I'm following up on some old work my colleague Mark Doffman did to try
and get support for the AUTOMATIC keyword into trunk. In the enclosed patch
I've addressed the problem with it accepting 'automatic' outside -std=gnu (it
will now only accept AUTOMATIC under -std=gnu or -std=legacy). I've also added
some test cases and documentation.
To address some of the other questions about this patch:
* AUTOMATIC isn't in any official standard, but is supported by the Sun/Oracle
Fortran compiler:
http://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vn79/index.html#z400073dc651
and the IBM XL compiler:
https://www-304.ibm.com/support/docview.wss?uid=swg27018978&aid=1
* Making this patch is our second choice after modifying our source code. The
scale of our source means it's not practical to manually modify it. For other
legacy features we've been able to do some automated transforms, but we can't
figure out any way to do this for AUTOMATIC. There's a chance there will be
some other people out there stuck with legacy code who will benefit from this
change.
* I agree that 'automatic' can be easily confused with automatic objects. We
could rename the keyword to something else (perhaps 'stack'), but then that
removes compatibility with the Sun and IBM compilers.
This has been tested with check-gfortran for x86_64-pc-linux-gnu host &
target; there are no unexpected failures and the new test cases pass.
Mark Doffman's original emails were in January and February 2014 in case you
want to review them.
I am in the process of arranging copyright assignment. In the meantime, does
this look remotely OK?
2015-09-23 Jim MacArthur <jim.macart...@codethink.co.uk>
* decl.c (match_attr_spec): Add DECL_AUTOMATIC to enum. Recognise
the 'automatic' keyword and call gfc_add_automatic when it is used.
(gfc_match_automatic): New function. Match 'automatic' as a
statement and call gfc_add_automatic when it is used.
* gfortran.h (symbol_attribute): Add 'automatic' to bitfield.
(gfc_add_automatic) Add declaration.
* gfortran.texi: Document AUTOMATIC statement.
* match.h (gfc_match_automatic): Add declaration.
* symbol.c (check_conflict): Check for conflict between AUTOMATIC
and SAVE attributes.
* symbol.c (gfc_add_automatic): New function. Add automatic attribute,
if the current standard allows it, otherwise fail.
(gfc_copy_attr): Copy automatic attribute.
* trans-decl.c (gfc_finish_var_decl): Do not make variables static
if they have the 'automatic' attribute.
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 228055)
+++ gcc/fortran/decl.c (working copy)
@@ -3445,9 +3445,9 @@
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_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 */
+ DECL_PUBLIC, DECL_SAVE, DECL_AUTOMATIC, DECL_TARGET, DECL_VALUE,
+ DECL_VOLATILE, DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS,
+ DECL_CONTIGUOUS, DECL_NONE, GFC_DECL_END /* Sentinel */
};
/* GFC_DECL_END is the sentinel, index starts at 0. */
@@ -3508,6 +3508,14 @@
d = DECL_ASYNCHRONOUS;
}
break;
+
+ case 'u':
+ if (match_string_p ("tomatic"))
+ {
+ /* Matched "automatic". */
+ d = DECL_AUTOMATIC;
+ }
+ break;
}
break;
@@ -3774,6 +3782,9 @@
case DECL_SAVE:
attr = "SAVE";
break;
+ case DECL_AUTOMATIC:
+ attr = "AUTOMATIC";
+ break;
case DECL_TARGET:
attr = "TARGET";
break;
@@ -3942,6 +3953,10 @@
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;
@@ -7389,7 +7404,41 @@
return MATCH_ERROR;
}
+match
+gfc_match_automatic (void)
+{
+ gfc_symbol *sym;
+ match m;
+ gfc_match (" ::");
+
+ for (;;)
+ {
+ m = gfc_match_symbol (&sym, 0);
+ switch (m)
+ {
+ case MATCH_YES:
+ if (!gfc_add_automatic (&sym->attr, sym->name,
+ &gfc_current_locus))
+ return MATCH_ERROR;
+ if (gfc_match_eos () == MATCH_YES)
+ return MATCH_YES;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ break;
+ case MATCH_NO:
+ goto syntax;
+ case MATCH_ERROR:
+ return MATCH_ERROR;
+ }
+ }
+
+syntax:
+ gfc_error ("Syntax error in AUTOMATIC statement at %C");
+ return MATCH_ERROR;
+}
+
+
match
gfc_match_value (void)
{
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 228055)
+++ gcc/fortran/gfortran.h (working copy)
@@ -712,7 +712,7 @@
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
@@ -2761,7 +2761,7 @@
bool gfc_add_explicit_interface (gfc_symbol *, ifsrc,
gfc_formal_arglist *, locus *);
bool gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
-
+bool gfc_add_automatic (symbol_attribute *, const char *, locus *);
void gfc_clear_attr (symbol_attribute *);
bool gfc_missing_attr (symbol_attribute *, locus *);
bool gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi (revision 228055)
+++ gcc/fortran/gfortran.texi (working copy)
@@ -1441,6 +1441,7 @@
* OpenACC::
* Argument list functions::
* Read/Write after EOF marker::
+* AUTOMATIC statement::
@end menu
@node Old-style kind specifications
@@ -2099,6 +2100,16 @@
the file before the EOF marker. As an extension, the run-time error may
be disabled using -std=legacy.
+@node AUTOMATIC statement
+@subsection AUTOMATIC statement
+@cindex AUTOMATIC statement
+
+AUTOMATIC is a counterpart to the SAVE statement. While SAVE forces variables
+to be placed in non-stack memory where it won't be overwritten,
+AUTOMATIC forces all variables declared with it to be on the stack.
+
+AUTOMATIC overrides -fno-automatic.
+
@node Extensions not implemented in GNU Fortran
@section Extensions not implemented in GNU Fortran
@cindex extensions, not implemented
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h (revision 228055)
+++ gcc/fortran/match.h (working copy)
@@ -230,6 +230,7 @@
match gfc_match_private (gfc_statement *);
match gfc_match_public (gfc_statement *);
match gfc_match_save (void);
+match gfc_match_automatic (void);
match gfc_match_modproc (void);
match gfc_match_target (void);
match gfc_match_value (void);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 228055)
+++ gcc/fortran/parse.c (working copy)
@@ -192,6 +192,7 @@
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':
@@ -424,6 +425,7 @@
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':
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 228055)
+++ gcc/fortran/symbol.c (working copy)
@@ -356,9 +356,9 @@
static bool
check_conflict (symbol_attribute *attr, const char *name, locus *where)
{
- static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
- *target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
- *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
+ static const char *dummy = "DUMMY", *save = "SAVE", *automatic = "AUTOMATIC",
+ *pointer = "POINTER", *target = "TARGET", *external = "EXTERNAL",
+ *intent = "INTENT", *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
*intent_out = "INTENT(OUT)", *intent_inout = "INTENT(INOUT)",
*allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL",
*privat = "PRIVATE", *recursive = "RECURSIVE",
@@ -427,6 +427,35 @@
}
}
+ if (attr->automatic)
+ {
+ conf (save, automatic);
+ conf (data, automatic);
+ conf (in_common, automatic);
+
+ switch (attr->flavor)
+ {
+ case FL_PROGRAM:
+ case FL_BLOCK_DATA:
+ case FL_MODULE:
+ case FL_LABEL:
+ case FL_DERIVED:
+ case FL_PARAMETER:
+ a1 = gfc_code2string (flavors, attr->flavor);
+ a2 = save;
+ goto conflict;
+ case FL_NAMELIST:
+ gfc_error ("Namelist group name at %L cannot have the "
+ "AUTOMATIC attribute", where);
+ return false;
+ break;
+ case FL_PROCEDURE:
+ case FL_VARIABLE:
+ default:
+ break;
+ }
+ }
+
if (attr->save == SAVE_EXPLICIT)
{
conf (dummy, save);
@@ -1150,7 +1179,22 @@
return check_conflict (attr, name, where);
}
+bool
+gfc_add_automatic (symbol_attribute *attr, const char *name, locus *where)
+{
+ if (check_used (attr, name, where))
+ return false;
+
+ if (!gfc_notify_std (GFC_STD_LEGACY,
+ "AUTOMATIC attribute specified at %L",
+ where))
+ return false;
+
+ attr->automatic = 1;
+ return check_conflict (attr, name, where);
+}
+
bool
gfc_add_value (symbol_attribute *attr, const char *name, locus *where)
{
@@ -1800,6 +1844,8 @@
goto fail;
if (src->value && !gfc_add_value (dest, NULL, where))
goto fail;
+ if (src->automatic && !gfc_add_automatic (dest, NULL, where))
+ goto fail;
if (src->volatile_ && !gfc_add_volatile (dest, NULL, where))
goto fail;
if (src->asynchronous && !gfc_add_asynchronous (dest, NULL, where))
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 228055)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -648,6 +648,7 @@
if (!sym->ns->proc_name->attr.recursive
&& INTEGER_CST_P (DECL_SIZE_UNIT (decl))
&& !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
+ && !sym->attr.automatic
/* Put variable length auto array pointers always into stack. */
&& (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
|| sym->attr.dimension == 0
! { dg-do run }
! { dg-options "-O2 -std=legacy -fno-automatic" }
subroutine foo (b)
logical b
integer i, j
character*24 s
automatic i
if (b) then
i = 26
j = 131
s = 'This is a test string'
else
if (i .eq. 26 .or. j .ne. 131) call abort
if (s .ne. 'This is a test string') call abort
end if
end subroutine foo
subroutine bar (s)
character*42 s
if (s .ne. '0123456789012345678901234567890123456') call abort
call foo (.false.)
end subroutine bar
subroutine baz
character*42 s
! Just clobber stack a little bit.
s = '0123456789012345678901234567890123456'
call bar (s)
end subroutine baz
call foo (.true.)
call baz
call foo (.false.)
end
! { dg-do compile }
! { dg-options "-std=legacy -fno-automatic" }
! A common variable may not have the AUTOMATIC attribute.
INTEGER, AUTOMATIC :: X
COMMON /COM/ X ! { dg-error "conflicts with AUTOMATIC attribute" }
END
! { dg-do compile }
! { dg-options "-std=legacy -fno-automatic" }
! An AUTOMATIC statement cannot be used with SAVE
FUNCTION X()
DATA y/2.5/
AUTOMATIC y ! { dg-error "DATA attribute conflicts with AUTOMATIC attribute" }
y = 1
END FUNCTION X
END
! { dg-do compile }
! { dg-options "-std=legacy -fno-automatic" }
! An AUTOMATIC statement cannot duplicated
FUNCTION X()
REAL, AUTOMATIC, AUTOMATIC :: Y ! { dg-error "Duplicate AUTOMATIC attribute" }
y = 1
END FUNCTION X
END
! { dg-do compile }
! { dg-options "-std=legacy -fno-automatic" }
! An AUTOMATIC statement cannot be used with SAVE
FUNCTION X()
REAL, SAVE, AUTOMATIC :: Y ! { dg-error "SAVE attribute conflicts with
AUTOMATIC attribute" }
y = 1
END FUNCTION X
END
