Fortran 2018 makes procedures recursive by default (effectively making
the existing RECURSIVE attribute a no-op). Instead it adds a
NON_RECURSIVE attribute that a programmer can use to mark a procedure
that may not be called recursively. This patch adds support for that.
Regtested on x86_64-pc-linux-gnu, Ok for trunk?
gcc/fortran/ChangeLog:
2017-12-19 Janne Blomqvist <j...@gcc.gnu.org>
* decl.c (gfc_match_prefix): Check for NON_RECURSIVE.
(copy_prefix): Copy non_recursive attribute as well.
(gfc_match_entry): Likewise.
* gfortran.h (gfc_add_non_recursive): New prototype.
* gfortran.texi: Mention NON_RECURSIVE in F2018 section.
* parse.c (gfc_build_block_ns): Copy non_recursive attribute.
* primary.c (gfc_match_rvalue): Check non_recursive attribute.
* resolve.c (resolve_procedure_interface): Copy non_recursive
attribute.
(is_illegal_recursion): Check non_recursive attribute,
GFC_STD_F2018.
(resolve_procedure_expression): Update error message.
(resolve_function): Don't check attribute taken care of in
is_illegal_recursion.
(resolve_fl_procedure): Check that non_recursive attributes match.
(resolve_component): Copy non_recursive attribute.
* symbol.c (gfc_add_non_recursive): New function.
gcc/testsuite/ChangeLog:
2017-12-19 Janne Blomqvist <j...@gcc.gnu.org>
* gfortran.dg/entry_18.f90: Add -std=f95
* gfortran.dg/non_recursive_1.f90: New test.
* gfortran.dg/non_recursive_2.f90: New test.
* gfortran.dg/pr78619.f90: Add -std=f2008.
* gfortran.dg/recursive_check_1.f: Add -std=f95.
* gfortran.dg/recursive_check_2.f90: Likewise.
* gfortran.dg/recursive_check_4.f03: Add -std=f2003.
* gfortran.dg/recursive_check_6.f03: Likewise.
* gfortran.dg/recursive_f2018.f90: New test.
---
gcc/fortran/decl.c | 29 +++++++++++++++++++++++++
gcc/fortran/gfortran.h | 3 ++-
gcc/fortran/gfortran.texi | 6 ++++-
gcc/fortran/parse.c | 5 ++++-
gcc/fortran/primary.c | 2 +-
gcc/fortran/resolve.c | 22 +++++++++++++++----
gcc/fortran/symbol.c | 18 +++++++++++++++
gcc/testsuite/gfortran.dg/entry_18.f90 | 1 +
gcc/testsuite/gfortran.dg/non_recursive_1.f90 | 11 ++++++++++
gcc/testsuite/gfortran.dg/non_recursive_2.f90 | 8 +++++++
gcc/testsuite/gfortran.dg/pr78619.f90 | 2 +-
gcc/testsuite/gfortran.dg/recursive_check_1.f | 1 +
gcc/testsuite/gfortran.dg/recursive_check_2.f90 | 1 +
gcc/testsuite/gfortran.dg/recursive_check_4.f03 | 2 +-
gcc/testsuite/gfortran.dg/recursive_check_6.f03 | 2 +-
gcc/testsuite/gfortran.dg/recursive_f2018.f90 | 7 ++++++
16 files changed, 109 insertions(+), 11 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/non_recursive_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/non_recursive_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/recursive_f2018.f90
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 53a87b6..ebb5061 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5751,6 +5751,8 @@ gfc_match_prefix (gfc_typespec *ts)
bool seen_type;
bool seen_impure;
bool found_prefix;
+ bool seen_recursive = false;
+ bool seen_non_recursive = false;
gfc_clear_attr (¤t_attr);
seen_type = false;
@@ -5801,11 +5803,24 @@ gfc_match_prefix (gfc_typespec *ts)
found_prefix = true;
}
+ if (gfc_match ("non_recursive% ") == MATCH_YES)
+ {
+ if (!gfc_notify_std (GFC_STD_F2018, "NON_RECURSIVE procedure at %C"))
+ goto error;
+
+ if (!gfc_add_non_recursive (¤t_attr, NULL))
+ goto error;
+
+ seen_non_recursive = true;
+ found_prefix = true;
+ }
+
if (gfc_match ("recursive% ") == MATCH_YES)
{
if (!gfc_add_recursive (¤t_attr, NULL))
goto error;
+ seen_recursive = true;
found_prefix = true;
}
@@ -5830,6 +5845,13 @@ gfc_match_prefix (gfc_typespec *ts)
goto error;
}
+ /* Can't have both RECURSIVE and NON_RECURSIVE. */
+ if (seen_recursive && seen_non_recursive)
+ {
+ gfc_error ("RECURSIVE and NON_RECURSIVE must not both appear at %C");
+ goto error;
+ }
+
/* If IMPURE it not seen but the procedure is ELEMENTAL, mark it as PURE. */
if (!seen_impure && current_attr.elemental && !current_attr.pure)
{
@@ -5866,6 +5888,9 @@ copy_prefix (symbol_attribute *dest, locus *where)
if (current_attr.recursive)
dest->recursive = 1;
+ if (current_attr.non_recursive)
+ dest->non_recursive = 1;
+
/* Module procedures are unusual in that the 'dest' is copied from
the interface declaration. However, this is an oportunity to
check that the submodule declaration is compliant with the
@@ -5903,6 +5928,9 @@ copy_prefix (symbol_attribute *dest, locus *where)
if (current_attr.recursive && !gfc_add_recursive (dest, where))
return false;
+ if (current_attr.non_recursive && !gfc_add_non_recursive (dest, where))
+ return false;
+
return true;
}
@@ -7203,6 +7231,7 @@ gfc_match_entry (void)
}
entry->attr.recursive = proc->attr.recursive;
+ entry->attr.non_recursive = proc->attr.non_recursive;
entry->attr.elemental = proc->attr.elemental;
entry->attr.pure = proc->attr.pure;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c5e62d7..81992ae 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -794,7 +794,7 @@ typedef struct
unsigned is_iso_c:1; /* Symbol is from iso_c_binding. */
/* Function/subroutine attributes */
- unsigned sequence:1, elemental:1, pure:1, recursive:1;
+ unsigned sequence:1, elemental:1, pure:1, recursive:1, non_recursive:1;
unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
/* Set if this is a module function or subroutine. Note that it is an
@@ -2950,6 +2950,7 @@ bool gfc_add_sequence (symbol_attribute *, const char *,
locus *);
bool gfc_add_elemental (symbol_attribute *, locus *);
bool gfc_add_pure (symbol_attribute *, locus *);
bool gfc_add_recursive (symbol_attribute *, locus *);
+bool gfc_add_non_recursive (symbol_attribute *, locus *);
bool gfc_add_function (symbol_attribute *, const char *, locus *);
bool gfc_add_subroutine (symbol_attribute *, const char *, locus *);
bool gfc_add_volatile (symbol_attribute *, const char *, locus *);
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index aabf268..3aba132 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1162,10 +1162,14 @@ Support the @code{IMPLICIT NONE} statement with an
@code{implicit-none-spec-list}.
@item Behavior of INQUIRE with the RECL= specifier
-
The behavior of the @code{INQUIRE} statement with the @code{RECL=}
specifier now conforms to Fortran 2018.
+@item NON_RECURSIVE procedure attribute
+Procedures are now permitted to be used recursively by default, and
+the NON_RECURSIVE attribute is supported to mark procedures as
+incompatible with recursion.
+
@end itemize
@c ---------------------------------------------------------------------
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 08bff3f..1a7b655 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4431,7 +4431,10 @@ gfc_build_block_ns (gfc_namespace *parent_ns)
}
if (parent_ns->proc_name)
- my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive;
+ {
+ my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive;
+ my_ns->proc_name->attr.non_recursive =
parent_ns->proc_name->attr.non_recursive;
+ }
return my_ns;
}
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 8537d93..8e4b379 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -3310,7 +3310,7 @@ gfc_match_rvalue (gfc_expr **result)
if (st != NULL
&& st->state == COMP_FUNCTION
&& st->sym == sym
- && !sym->attr.recursive)
+ && (!sym->attr.recursive || sym->attr.non_recursive))
{
e = gfc_get_expr ();
e->symtree = symtree;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f819b71..706457d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -238,6 +238,7 @@ resolve_procedure_interface (gfc_symbol *sym)
sym->attr.elemental = ifc->attr.elemental;
sym->attr.contiguous = ifc->attr.contiguous;
sym->attr.recursive = ifc->attr.recursive;
+ sym->attr.non_recursive = ifc->attr.non_recursive;
sym->attr.always_explicit = ifc->attr.always_explicit;
sym->attr.ext_attr |= ifc->attr.ext_attr;
sym->attr.is_bind_c = ifc->attr.is_bind_c;
@@ -1684,8 +1685,12 @@ is_illegal_recursion (gfc_symbol* sym, gfc_namespace*
context)
else
proc_sym = sym;
+ if (proc_sym->attr.non_recursive)
+ return true;
+
/* If sym is RECURSIVE, all is well of course. */
- if (proc_sym->attr.recursive || flag_recursive)
+ if (proc_sym->attr.recursive || flag_recursive
+ || gfc_option.allow_std & GFC_STD_F2018)
return false;
/* Find the context procedure's "real" symbol if it has entries.
@@ -1847,8 +1852,8 @@ resolve_procedure_expression (gfc_expr* expr)
own body is in danger of being called recursively. */
if (is_illegal_recursion (sym, gfc_current_ns))
gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling"
- " itself recursively. Declare it RECURSIVE or use"
- " %<-frecursive%>", sym->name, &expr->where);
+ " itself recursively. Use %<-std=gnu%>, %<-std=f2018%>, or"
+ " newer, or declare it RECURSIVE", sym->name, &expr->where);
return true;
}
@@ -3249,7 +3254,7 @@ resolve_function (gfc_expr *expr)
/* Functions without the RECURSIVE attribution are not allowed to
* call themselves. */
- if (expr->value.function.esym && !expr->value.function.esym->attr.recursive)
+ if (expr->value.function.esym)
{
gfc_symbol *esym;
esym = expr->value.function.esym;
@@ -12558,6 +12563,14 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
return false;
}
+ if (sym->attr.non_recursive != iface->attr.non_recursive)
+ {
+ gfc_error ("Mismatch in NON_RECURSIVE attribute between MODULE "
+ "PROCEDURE at %L and its interface in %s",
+ &sym->declared_at, module_name);
+ return false;
+ }
+
/* Check the result characteristics. */
if (!gfc_check_result_characteristics (sym, iface, errmsg, 200))
{
@@ -13590,6 +13603,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
c->attr.pure = ifc->attr.pure;
c->attr.elemental = ifc->attr.elemental;
c->attr.recursive = ifc->attr.recursive;
+ c->attr.non_recursive = ifc->attr.non_recursive;
c->attr.always_explicit = ifc->attr.always_explicit;
c->attr.ext_attr |= ifc->attr.ext_attr;
/* Copy char length. */
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index dc1688a..c349572 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1630,6 +1630,24 @@ gfc_add_recursive (symbol_attribute *attr, locus *where)
bool
+gfc_add_non_recursive (symbol_attribute *attr, locus *where)
+{
+
+ if (check_used (attr, NULL, where))
+ return false;
+
+ if (attr->non_recursive)
+ {
+ duplicate_attr ("NON_RECURSIVE", where);
+ return false;
+ }
+
+ attr->non_recursive = 1;
+ return check_conflict (attr, NULL, where);
+}
+
+
+bool
gfc_add_entry (symbol_attribute *attr, const char *name, locus *where)
{
diff --git a/gcc/testsuite/gfortran.dg/entry_18.f90
b/gcc/testsuite/gfortran.dg/entry_18.f90
index b9cc417..9f96d14 100644
--- a/gcc/testsuite/gfortran.dg/entry_18.f90
+++ b/gcc/testsuite/gfortran.dg/entry_18.f90
@@ -1,4 +1,5 @@
! { dg-do compile }
+! { dg-options "-std=f95" }
! Test fix for PR37583, in which:
! (i) the reference to glocal prior to the ENTRY caused an internal
! error and
diff --git a/gcc/testsuite/gfortran.dg/non_recursive_1.f90
b/gcc/testsuite/gfortran.dg/non_recursive_1.f90
new file mode 100644
index 0000000..3975293
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_recursive_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2008 -fmax-errors=1" }
+!
+! F2018 permits NON_RECURSIVE procedures. Check that we complain if we
+! choose an earlier standard.
+!
+! TODO: Parser gets confused after the error, hence -fmax-errors=1
+!
+! { dg-prune-output "compilation terminated" }
+non_recursive subroutine foo() ! { dg-error "Fortran 2018: NON_RECURSIVE
procedure" }
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/non_recursive_2.f90
b/gcc/testsuite/gfortran.dg/non_recursive_2.f90
new file mode 100644
index 0000000..455a9fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_recursive_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+!
+! F2018 permits NON_RECURSIVE procedures. Check that we complain if we
+! try to recurse in such a procedure.
+!
+non_recursive subroutine foo()
+ call foo() ! { dg-error "is not RECURSIVE" }
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/pr78619.f90
b/gcc/testsuite/gfortran.dg/pr78619.f90
index 5fbe185..6385f50 100644
--- a/gcc/testsuite/gfortran.dg/pr78619.f90
+++ b/gcc/testsuite/gfortran.dg/pr78619.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Werror -O3" }
+! { dg-options "-Werror -O3 -std=f2008" }
!
! Tests the fix for PR78619, in which the recursive use of 'f' at line 13
! caused an ICE.
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_1.f
b/gcc/testsuite/gfortran.dg/recursive_check_1.f
index 7c292af..beb6923 100644
--- a/gcc/testsuite/gfortran.dg/recursive_check_1.f
+++ b/gcc/testsuite/gfortran.dg/recursive_check_1.f
@@ -1,4 +1,5 @@
! { dg-do compile }
+! { dg-options "-std=f95" }
! PR fortran/26551
SUBROUTINE SUB()
CALL SUB() ! { dg-error "is not RECURSIVE" }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_2.f90
b/gcc/testsuite/gfortran.dg/recursive_check_2.f90
index 15608ee..d0e4ade 100644
--- a/gcc/testsuite/gfortran.dg/recursive_check_2.f90
+++ b/gcc/testsuite/gfortran.dg/recursive_check_2.f90
@@ -1,4 +1,5 @@
! { dg-do compile }
+! { dg-options "-std=f95" }
! PR fortran/26551
function func2()
integer func2
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_4.f03
b/gcc/testsuite/gfortran.dg/recursive_check_4.f03
index ece42ca..bbcfcfa 100644
--- a/gcc/testsuite/gfortran.dg/recursive_check_4.f03
+++ b/gcc/testsuite/gfortran.dg/recursive_check_4.f03
@@ -1,5 +1,5 @@
! { dg-do compile }
-
+! { dg-options "-std=f2003" }
! PR fortran/37779
! Check that using a non-recursive procedure as "value" is an error.
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_6.f03
b/gcc/testsuite/gfortran.dg/recursive_check_6.f03
index 9414f58..028da99 100644
--- a/gcc/testsuite/gfortran.dg/recursive_check_6.f03
+++ b/gcc/testsuite/gfortran.dg/recursive_check_6.f03
@@ -1,5 +1,5 @@
! { dg-do compile }
-
+! { dg-options "-std=f2003" }
! PR fortran/37779
! Check that a call to a procedure's containing procedure counts as recursive
! and is rejected if the containing procedure is not RECURSIVE.
diff --git a/gcc/testsuite/gfortran.dg/recursive_f2018.f90
b/gcc/testsuite/gfortran.dg/recursive_f2018.f90
new file mode 100644
index 0000000..59d267a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_f2018.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+!
+! F2018 permits recursive procedures by default. Check that we allow that.
+!
+subroutine bar()
+ call bar()
+end subroutine bar
--
2.7.4
