re PR fortran/26551 (gfortran compiles recursive subroutines declared without the RECURSIVE attribute)

PR fortran/26551

	* resolve.c (resolve_call, resolve_function): Issue an error
	if a function or subroutine call is recursive but the function or
	subroutine wasn't declared as such.

	* gfortran.dg/recursive_check_1.f: New test.

From-SVN: r113860

gcc/fortran/ChangeLog

@@ -1,3 +1,16 @@
+2006-05-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/26551
+	* resolve.c (resolve_call, resolve_function): Issue an error
+	if a function or subroutine call is recursive but the function or
+	subroutine wasn't declared as such.
+
+2006-05-07  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/26551
+	* gfortran.dg/recursive_check_1.f: New test.
+
+
 2006-05-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR fortran/27320

gcc/fortran/resolve.c

@@ -1380,6 +1380,30 @@ 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)
+    {
+      gfc_symbol *esym, *proc;
+      esym = expr->value.function.esym;
+      proc = gfc_current_ns->proc_name;
+      if (esym == proc)
+      {
+        gfc_error ("Function '%s' at %L cannot call itself, as it is not "
+                   "RECURSIVE", name, &expr->where);
+        t = FAILURE;
+      }
+
+      if (esym->attr.entry && esym->ns->entries && proc->ns->entries
+          && esym->ns->entries->sym == proc->ns->entries->sym)
+      {
+        gfc_error ("Call to ENTRY '%s' at %L is recursive, but function "
+                   "'%s' is not declared as RECURSIVE",
+                   esym->name, &expr->where, esym->ns->entries->sym->name);
+        t = FAILURE;
+      }
+    }
+
   /* Character lengths of use associated functions may contains references to
      symbols not referenced from the current program unit otherwise.  Make sure
      those symbols are marked as referenced.  */
@@ -1629,6 +1653,30 @@ resolve_call (gfc_code * c)
 	&& !c->symtree->n.sym->attr.use_assoc)
     resolve_global_procedure (c->symtree->n.sym, &c->loc, 1);
 
+  /* Subroutines without the RECURSIVE attribution are not allowed to
+   * call themselves.  */
+  if (c->symtree && c->symtree->n.sym && !c->symtree->n.sym->attr.recursive)
+    {
+      gfc_symbol *csym, *proc;
+      csym = c->symtree->n.sym;
+      proc = gfc_current_ns->proc_name;
+      if (csym == proc)
+      {
+        gfc_error ("SUBROUTINE '%s' at %L cannot call itself, as it is not "
+                   "RECURSIVE", csym->name, &c->loc);
+        t = FAILURE;
+      }
+
+      if (csym->attr.entry && csym->ns->entries && proc->ns->entries
+          && csym->ns->entries->sym == proc->ns->entries->sym)
+      {
+        gfc_error ("Call to ENTRY '%s' at %L is recursive, but subroutine "
+                   "'%s' is not declared as RECURSIVE",
+                   csym->name, &c->loc, csym->ns->entries->sym->name);
+        t = FAILURE;
+      }
+    }
+
   /* Switch off assumed size checking and do this again for certain kinds
      of procedure, once the procedure itself is resolved.  */
   need_full_assumed_size++;

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2006-05-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/26551
+	* gfortran.dg/recursive_check_1.f: New test.
+
 2005-05-17  Bernd Schmidt  <bernd.schmidt@analog.com>
 
 	* g++.dg/opt/temp2.C: New test.

gcc/testsuite/gfortran.dg/recursive_check_1.f

@@ -0,0 +1,27 @@
+! { dg-do compile }
+! PR fortran/26551
+      SUBROUTINE SUB()
+      CALL SUB() ! { dg-error "cannot call itself, as it is not RECURSIVE" }
+      END SUBROUTINE
+
+      FUNCTION FUNC() RESULT (FOO)
+      INTEGER FOO
+      FOO = FUNC() ! { dg-error "cannot call itself, as it is not RECURSIVE" }
+      END FUNCTION
+
+      SUBROUTINE SUB2()
+      ENTRY ENT2()
+      CALL ENT2() ! { dg-error "is not declared as RECURSIVE" }
+      END SUBROUTINE
+
+      function func2()
+      integer func2
+      func2 = 42
+      return
+      entry c() result (foo)
+      foo = b() ! { dg-error "is not declared as RECURSIVE" }
+      return
+      entry b() result (bar)
+      bar = 12
+      return
+      end function