diff options
author | Janus Weil <janus@gcc.gnu.org> | 2013-02-12 13:15:26 +0100 |
---|---|---|
committer | Janus Weil <janus@gcc.gnu.org> | 2013-02-12 13:15:26 +0100 |
commit | fdb1fa9ebe52bb178f41a27ea5b55b5c17d1aa3c (patch) | |
tree | 6e80b175fc0a56ceefcc79eccd6632d7837107de /gcc/fortran | |
parent | fdec36abf907e49e9af101877a9f11dd26cb6516 (diff) | |
download | gcc-fdb1fa9ebe52bb178f41a27ea5b55b5c17d1aa3c.tar.gz |
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
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 40 |
2 files changed, 27 insertions, 19 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 52b610dab03..0a08a199fe4 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 1bb18c97a8b..b5faacadf96 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 |