re PR fortran/46952 ([OOP] Spurious "recursive call" error with type bound procedure)

2013-02-12  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46952
	* resolve.c (resolve_call): Do not check deferred procedures for
	recursiveness.


2013-02-12  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46952
	* gfortran.dg/typebound_deferred_1.f90: New.

From-SVN: r195975

4 files changed, 55 insertions, 19 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 52b610d..0a08a19 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-02-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46952
+	* resolve.c (resolve_call): Do not check deferred procedures for
+	recursiveness.
+
 2013-02-09  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/55362
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1bb18c9..b5faaca 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3785,28 +3785,30 @@ resolve_call (gfc_code *c)
 	}
     }
 
-  /* If this ia a deferred TBP with an abstract interface
-     (which may of course be referenced), c->expr1 will be set.  */
-  if (csym && csym->attr.abstract && !c->expr1)
+  /* If this ia a deferred TBP, c->expr1 will be set.  */
+  if (!c->expr1 && csym)
     {
-      gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
-		 csym->name, &c->loc);
-      return FAILURE;
-    }
+      if (csym->attr.abstract)
+	{
+	  gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
+		    csym->name, &c->loc);
+	  return FAILURE;
+	}
 
-  /* Subroutines without the RECURSIVE attribution are not allowed to
-   * call themselves.  */
-  if (csym && is_illegal_recursion (csym, gfc_current_ns))
-    {
-      if (csym->attr.entry && csym->ns->entries)
-	gfc_error ("ENTRY '%s' at %L cannot be called recursively, as"
-		   " subroutine '%s' is not RECURSIVE",
-		   csym->name, &c->loc, csym->ns->entries->sym->name);
-      else
-	gfc_error ("SUBROUTINE '%s' at %L cannot be called recursively, as it"
-		   " is not RECURSIVE", csym->name, &c->loc);
+      /* Subroutines without the RECURSIVE attribution are not allowed to
+	 call themselves.  */
+      if (is_illegal_recursion (csym, gfc_current_ns))
+	{
+	  if (csym->attr.entry && csym->ns->entries)
+	    gfc_error ("ENTRY '%s' at %L cannot be called recursively, "
+		       "as subroutine '%s' is not RECURSIVE",
+		       csym->name, &c->loc, csym->ns->entries->sym->name);
+	  else
+	    gfc_error ("SUBROUTINE '%s' at %L cannot be called recursively, "
+		       "as it is not RECURSIVE", csym->name, &c->loc);
 
-      t = FAILURE;
+	  t = FAILURE;
+	}
     }
 
   /* Switch off assumed size checking and do this again for certain kinds
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e9ab329..f99e66e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-02-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46952
+	* gfortran.dg/typebound_deferred_1.f90: New.
+
 2013-02-12  Jakub Jelinek  <jakub@redhat.com>
 
 	PR rtl-optimization/56151
diff --git a/gcc/testsuite/gfortran.dg/typebound_deferred_1.f90 b/gcc/testsuite/gfortran.dg/typebound_deferred_1.f90
new file mode 100644
index 0000000..6e6dc52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_deferred_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR 46952: [OOP] Spurious "recursive call" error with type bound procedure
+!
+! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+
+module m
+
+  type, abstract :: t
+  contains
+    procedure(inter), pass, deferred :: foo
+  end type
+
+contains
+
+  subroutine inter(this)
+    class(t) :: this
+    call this%foo()
+  end subroutine inter
+
+end module m 
+
+! { dg-final { cleanup-modules "m" } }