From 8bae6273fbc016a8f055ee90baa824a21c285b6a Mon Sep 17 00:00:00 2001
From: Janus Weil <janus@gcc.gnu.org>
Date: Thu, 5 Nov 2009 11:42:48 +0100
Subject: [PATCH] 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
---
gcc/fortran/ChangeLog | 8 +++++
gcc/fortran/resolve.c | 13 ++++++-
gcc/testsuite/ChangeLog | 6 ++++
.../gfortran.dg/interface_abstract_4.f90 | 35 +++++++++++++++++++
4 files changed, 61 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/interface_abstract_4.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5bf0ccc7aaac..dca8031f0d5f 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 4a83f22dfd45..a721d944b33f 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 895faab5e0a0..9d16f915c5a4 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 000000000000..50f101577e67
--- /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
--
GitLab