re PR fortran/41556 ([OOP] Errors in applying operator/assignment to an abstract type)

2009-11-05  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41556
	PR fortran/41873
	* resolve.c (resolve_function,resolve_call): Prevent abstract interfaces
	from being called, but allow deferred type-bound procedures with
	abstract interface.


2009-11-05  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41556
	PR fortran/41873
	* gfortran.dg/interface_abstract_4.f90: New test.

From-SVN: r153934

4 files changed, 61 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5bf0ccc..dca8031 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-11-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41556
+	PR fortran/41873
+	* resolve.c (resolve_function,resolve_call): Prevent abstract interfaces
+	from being called, but allow deferred type-bound procedures with
+	abstract interface.
+
 2009-11-04  Tobias Burnus <burnus@gcc.gnu.org>
 	    Janus Weil  <janus@gcc.gnu.org>
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4a83f22..a721d94 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2526,7 +2526,9 @@ resolve_function (gfc_expr *expr)
       return FAILURE;
     }
 
-  if (sym && sym->attr.abstract)
+  /* If this ia a deferred TBP with an abstract interface (which may
+     of course be referenced), expr->value.function.name will be set.  */
+  if (sym && sym->attr.abstract && !expr->value.function.name)
     {
       gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
 		 sym->name, &expr->where);
@@ -3138,6 +3140,15 @@ 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)
+    {
+      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))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 895faab..9d16f91 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-11-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41556
+	PR fortran/41873
+	* gfortran.dg/interface_abstract_4.f90: New test.
+
 2009-11-05  Maxim Kuvyrkov  <maxim@codesourcery.com>
 
 	* gcc.target/m68k/pr41302.c: Fix target triplet.
diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_4.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_4.f90
new file mode 100644
index 0000000..50f1015
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_abstract_4.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR 41873: Bogus Error: ABSTRACT INTERFACE must not be referenced...
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+  implicit none
+
+  type, abstract :: abstype
+  contains
+    procedure(f), nopass, deferred :: f_bound
+    procedure(s), nopass, deferred :: s_bound
+  end type
+
+  abstract interface
+    real function f ()
+    end function
+  end interface
+
+  abstract interface
+    subroutine s
+    end subroutine
+  end interface
+
+contains
+
+  subroutine cg (c)
+    class(abstype) :: c
+    print *, f()             ! { dg-error "must not be referenced" }
+    call s                   ! { dg-error "must not be referenced" }
+    print *, c%f_bound ()
+    call c%s_bound ()
+  end subroutine
+
+end