From: Fritz Reese Date: Fri, 23 Sep 2016 21:06:18 +0000 (+0000) Subject: lang.opt, [...]: New flag -fdec-static. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=34d567d1f58df1e737c8abf6140ee8ec41e92377;p=gcc.git lang.opt, [...]: New flag -fdec-static. 2016-09-23 Fritz Reese 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 daed721dbad..fbab438a959 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2016-09-23 Fritz Reese + + * 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 PR fortran/48298 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2982e86bac0..bc27f664512 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3811,6 +3811,7 @@ match_attr_spec (void) DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL, DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL, DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE, + DECL_STATIC, DECL_AUTOMATIC, DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE, DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_CONTIGUOUS, DECL_NONE, GFC_DECL_END /* Sentinel */ @@ -3874,6 +3875,14 @@ match_attr_spec (void) d = DECL_ASYNCHRONOUS; } break; + + case 'u': + if (match_string_p ("tomatic")) + { + /* Matched "automatic". */ + d = DECL_AUTOMATIC; + } + break; } break; @@ -4003,8 +4012,25 @@ match_attr_spec (void) break; case 's': - if (match_string_p ("save")) - d = DECL_SAVE; + gfc_next_ascii_char (); + switch (gfc_next_ascii_char ()) + { + case 'a': + if (match_string_p ("ve")) + { + /* Matched "save". */ + d = DECL_SAVE; + } + break; + + case 't': + if (match_string_p ("atic")) + { + /* Matched "static". */ + d = DECL_STATIC; + } + break; + } break; case 't': @@ -4141,6 +4167,12 @@ match_attr_spec (void) case DECL_SAVE: attr = "SAVE"; break; + case DECL_STATIC: + attr = "STATIC"; + break; + case DECL_AUTOMATIC: + attr = "AUTOMATIC"; + break; case DECL_TARGET: attr = "TARGET"; break; @@ -4169,6 +4201,18 @@ match_attr_spec (void) if (seen[d] == 0) continue; + if ((d == DECL_STATIC || d == DECL_AUTOMATIC) + && !flag_dec_static) + { + gfc_error ("%s at %L is a DEC extension, enable with -fdec-static", + d == DECL_STATIC ? "STATIC" : "AUTOMATIC", &seen_at[d]); + m = MATCH_ERROR; + goto cleanup; + } + /* Allow SAVE with STATIC, but don't complain. */ + if (d == DECL_STATIC && seen[DECL_SAVE]) + continue; + if (gfc_current_state () == COMP_DERIVED && d != DECL_DIMENSION && d != DECL_CODIMENSION && d != DECL_POINTER && d != DECL_PRIVATE @@ -4307,10 +4351,15 @@ match_attr_spec (void) &seen_at[d]); break; + case DECL_STATIC: case DECL_SAVE: t = gfc_add_save (¤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; @@ -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 1837a53ddb8..2cac42bad00 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -736,7 +736,7 @@ typedef struct optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1, dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1, implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1, - contiguous:1, fe_temp: 1; + contiguous:1, fe_temp: 1, automatic: 1; /* For CLASS containers, the pointer attribute is sometimes set internally even though it was not directly specified. In this case, keep the @@ -2816,6 +2816,7 @@ bool gfc_add_cray_pointee (symbol_attribute *, locus *); match gfc_mod_pointee_as (gfc_array_spec *); bool gfc_add_protected (symbol_attribute *, const char *, locus *); bool gfc_add_result (symbol_attribute *, const char *, locus *); +bool gfc_add_automatic (symbol_attribute *, const char *, locus *); bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *); bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *); bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *); diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 85c1986a71b..797730c7a7a 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -1462,6 +1462,7 @@ without warning. * STRUCTURE and RECORD:: * UNION and MAP:: * Type variants for integer intrinsics:: +* AUTOMATIC and STATIC attributes:: @end menu @node Old-style kind specifications @@ -2421,6 +2422,56 @@ here: @tab @code{--} @tab @code{FLOATI} @tab @code{FLOATJ} @tab @code{FLOATK} @end multitable +@node AUTOMATIC and STATIC attributes +@subsection @code{AUTOMATIC} and @code{STATIC} attributes +@cindex variable attributes +@cindex @code{AUTOMATIC} +@cindex @code{STATIC} + +With @option{-fdec-static} GNU Fortran supports the DEC extended attributes +@code{STATIC} and @code{AUTOMATIC} to provide explicit specification of entity +storage. These follow the syntax of the Fortran standard @code{SAVE} attribute. + +@code{STATIC} is exactly equivalent to @code{SAVE}, and specifies that +an entity should be allocated in static memory. As an example, @code{STATIC} +local variables will retain their values across multiple calls to a function. + +Entities marked @code{AUTOMATIC} will be stack automatic whenever possible. +@code{AUTOMATIC} is the default for local variables smaller than +@option{-fmax-stack-var-size}, unless @option{-fno-automatic} is given. This +attribute overrides @option{-fno-automatic}, @option{-fmax-stack-var-size}, and +blanket @code{SAVE} statements. + + +Examples: + +@example +subroutine f + integer, automatic :: i ! automatic variable + integer x, y ! static variables + save + ... +endsubroutine +@end example +@example +subroutine f + integer a, b, c, x, y, z + static :: x + save y + automatic z, c + ! a, b, c, and z are automatic + ! x and y are static +endsubroutine +@end example +@example +! Compiled with -fno-automatic +subroutine f + integer a, b, c, d + automatic :: a + ! a is automatic; b, c, and d are static +endsubroutine +@end example + @node Extensions not implemented in GNU Fortran @section Extensions not implemented in GNU Fortran @@ -2444,7 +2495,6 @@ code that uses them running with the GNU Fortran compiler. * ENCODE and DECODE statements:: * Variable FORMAT expressions:: @c * Q edit descriptor:: -@c * AUTOMATIC statement:: @c * TYPE and ACCEPT I/O Statements:: @c * .XOR. operator:: @c * CARRIAGECONTROL, DEFAULTFILE, DISPOSE and RECORDTYPE I/O specifiers:: diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 15c131ac865..268d155a796 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 8ec5400ec95..ef421d3b345 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 348ca701c92..24131635713 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 4aa8303dfeb..13dfa88c7c7 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 d78a2c07eec..a89e834b7be 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 9998302714a..7b068f91f2c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11348,10 +11348,11 @@ apply_default_init_local (gfc_symbol *sym) entry, so we just add a static initializer. Note that automatic variables are stack allocated even with -fno-automatic; we have also to exclude result variable, which are also nonstatic. */ - if (sym->attr.save || sym->ns->save_all - || (flag_max_stack_var_size == 0 && !sym->attr.result - && (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive) - && (!sym->attr.dimension || !is_non_constant_shape_array (sym)))) + if (!sym->attr.automatic + && (sym->attr.save || sym->ns->save_all + || (flag_max_stack_var_size == 0 && !sym->attr.result + && (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive) + && (!sym->attr.dimension || !is_non_constant_shape_array (sym))))) { /* Don't clobber an existing initializer! */ gcc_assert (sym->value == NULL); @@ -11496,7 +11497,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) a hidden default for allocatable components. */ if (!(sym->value || no_init_flag) && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE - && !sym->ns->save_all && !sym->attr.save + && !(sym->ns->save_all && !sym->attr.automatic) && !sym->attr.save && !sym->attr.pointer && !sym->attr.allocatable && gfc_has_default_initializer (sym->ts.u.derived) && !gfc_notify_std (GFC_STD_F2008, "Implied SAVE for module variable " @@ -14319,7 +14320,7 @@ resolve_symbol (gfc_symbol *sym) if (class_attr.codimension && !(class_attr.allocatable || sym->attr.dummy || sym->attr.save || sym->attr.select_type_temporary - || sym->ns->save_all + || (sym->ns->save_all && !sym->attr.automatic) || sym->ns->proc_name->attr.flavor == FL_MODULE || sym->ns->proc_name->attr.is_main_program || sym->attr.function || sym->attr.result || sym->attr.use_assoc)) @@ -14471,7 +14472,8 @@ resolve_symbol (gfc_symbol *sym) } /* Check threadprivate restrictions. */ - if (sym->attr.threadprivate && !sym->attr.save && !sym->ns->save_all + if (sym->attr.threadprivate && !sym->attr.save + && !(sym->ns->save_all && !sym->attr.automatic) && (!sym->attr.in_common && sym->module == NULL && (sym->ns->proc_name == NULL @@ -14482,7 +14484,7 @@ resolve_symbol (gfc_symbol *sym) if (sym->attr.omp_declare_target && sym->attr.flavor == FL_VARIABLE && !sym->attr.save - && !sym->ns->save_all + && !(sym->ns->save_all && !sym->attr.automatic) && (!sym->attr.in_common && sym->module == NULL && (sym->ns->proc_name == NULL diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 1b94622bf4b..3026356d111 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -382,7 +382,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) *is_bind_c = "BIND(C)", *procedure = "PROCEDURE", *proc_pointer = "PROCEDURE POINTER", *abstract = "ABSTRACT", *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION", - *contiguous = "CONTIGUOUS", *generic = "GENERIC"; + *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC"; static const char *threadprivate = "THREADPRIVATE"; static const char *omp_declare_target = "OMP DECLARE TARGET"; static const char *oacc_declare_copyin = "OACC DECLARE COPYIN"; @@ -447,6 +447,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (dummy, save); conf (in_common, save); conf (result, save); + conf (automatic, save); switch (attr->flavor) { @@ -488,6 +489,12 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (pointer, codimension); conf (allocatable, elemental); + conf (in_common, automatic); + conf (in_equivalence, automatic); + conf (result, automatic); + conf (use_assoc, automatic); + conf (dummy, automatic); + conf (target, external); conf (target, intrinsic); @@ -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 1bab5d5134a..407c4a1fdbc 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -660,7 +660,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) } /* Keep variables larger than max-stack-var-size off stack. */ - if (!sym->ns->proc_name->attr.recursive + if (!sym->ns->proc_name->attr.recursive && !sym->attr.automatic && INTEGER_CST_P (DECL_SIZE_UNIT (decl)) && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) /* Put variable length auto array pointers always into stack. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 09b6599c43a..f387022069b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2016-09-23 Fritz Reese + + * 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 PR fortran/48298 diff --git a/gcc/testsuite/gfortran.dg/dec_static_1.f90 b/gcc/testsuite/gfortran.dg/dec_static_1.f90 new file mode 100644 index 00000000000..7f319ec0a5c --- /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 00000000000..392f3427c14 --- /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 00000000000..48b62206bb8 --- /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 00000000000..91bed19fc41 --- /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