From 9d2264a0e7b161ca3466199851cb595e36192bb3 Mon Sep 17 00:00:00 2001 From: janus Date: Tue, 12 Feb 2013 12:15:26 +0000 Subject: [PATCH] 2013-02-12 Janus Weil PR fortran/46952 * resolve.c (resolve_call): Do not check deferred procedures for recursiveness. 2013-02-12 Janus Weil PR fortran/46952 * gfortran.dg/typebound_deferred_1.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@195975 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/resolve.c | 40 ++++++++++++---------- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/typebound_deferred_1.f90 | 23 +++++++++++++ 4 files changed, 55 insertions(+), 19 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/typebound_deferred_1.f90 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 + + PR fortran/46952 + * resolve.c (resolve_call): Do not check deferred procedures for + recursiveness. + 2013-02-09 Paul Thomas 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 + + PR fortran/46952 + * gfortran.dg/typebound_deferred_1.f90: New. + 2013-02-12 Jakub Jelinek 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 + +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" } } -- 2.7.4