This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] Add NON_RECURSIVE attribute for procedures


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  <jb@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  <jb@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 (&current_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 (&current_attr, NULL))
+	    goto error;
+
+	  seen_non_recursive = true;
+	  found_prefix = true;
+	}
+
       if (gfc_match ("recursive% ") == MATCH_YES)
 	{
 	  if (!gfc_add_recursive (&current_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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]