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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 52b610dab03fb6552a6f435b21f87f584417e8ce..0a08a199fe4f7eb5b6d6bd6372288cb403ee9c58 100644 (file)
--- 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 1bb18c97a8bcf064c257a06f38622897f00881f7..b5faacadf96f60dc1a892a06acbce45fbcb0124e 100644 (file)
--- 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 e9ab329328a3c80dbed755841e2612ef4dc5be31..f99e66ed0fbdd5e002e0df922f8e14f6e216de7a 100644 (file)
--- 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 (file)
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" } }