From ecd3b73c6dde9d7b61b811b3cab3ac823b63c181 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 21 Sep 2008 19:58:23 +0000 Subject: [PATCH] re PR fortran/37583 (ICE "insert_bbt(): Duplicate key" for self-calling ENTRY subprogram) 2008-09-21 Paul Thomas PR fortran/37583 * decl.c (scalarize_intrinsic_call): Both subroutines and functions can give a true for get_proc_mame's last argument so remove the &&gfc_current_ns->proc_name->attr.function. resolve.c (resolve_actual_arglist): Add check for recursion by reference to procedure as actual argument. 2008-09-21 Paul Thomas PR fortran/37583 * gfortran.dg/entry_18.f90: New test. From-SVN: r140532 --- gcc/fortran/ChangeLog | 9 +++++++++ gcc/fortran/decl.c | 3 +-- gcc/fortran/resolve.c | 9 +++++++++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/entry_18.f90 | 36 ++++++++++++++++++++++++++++++++++ 5 files changed, 60 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/entry_18.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6b466ed..e362413 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2008-09-21 Paul Thomas + + PR fortran/37583 + * decl.c (scalarize_intrinsic_call): Both subroutines and + functions can give a true for get_proc_mame's last argument so + remove the &&gfc_current_ns->proc_name->attr.function. + resolve.c (resolve_actual_arglist): Add check for recursion by + reference to procedure as actual argument. + 2008-09-21 Daniel Kraft PR fortran/35846 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 0fc2a95..370ac10 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4639,8 +4639,7 @@ gfc_match_entry (void) created symbols attached to the current namespace. */ if (get_proc_name (name, &entry, gfc_current_ns->parent != NULL - && module_procedure - && gfc_current_ns->proc_name->attr.function)) + && module_procedure)) return MATCH_ERROR; proc = gfc_current_block (); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f8f2df9..a7c62c3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1176,6 +1176,15 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, /* Just in case a specific was found for the expression. */ sym = e->symtree->n.sym; + if (sym->attr.entry && sym->ns->entries + && sym->ns == gfc_current_ns + && !sym->ns->entries->sym->attr.recursive) + { + gfc_error ("Reference to ENTRY '%s' at %L is recursive, but procedure " + "'%s' is not declared as RECURSIVE", + sym->name, &e->where, sym->ns->entries->sym->name); + } + /* If the symbol is the function that names the current (or parent) scope, then we really have a variable reference. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7ffa03a..c1ee1f8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-09-21 Paul Thomas + + PR fortran/37583 + * gfortran.dg/entry_18.f90: New test. + 2008-09-21 Daniel Kraft PR fortran/35846 diff --git a/gcc/testsuite/gfortran.dg/entry_18.f90 b/gcc/testsuite/gfortran.dg/entry_18.f90 new file mode 100644 index 0000000..e00aea7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_18.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! Test fix for PR37583, in which: +! (i) the reference to glocal prior to the ENTRY caused an internal +! error and +! (ii) the need for a RECURSIVE attribute was ignored. +! +! Contributed by Arjen Markus +! +module gsub +contains +recursive subroutine suba( g ) ! prefix with "RECURSIVE" + interface + real function g(x) + real x + end function + end interface + real :: x, y + call mysub( glocala ) + return +entry glocala( x, y ) + y = x +end subroutine +subroutine subb( g ) + interface + real function g(x) + real x + end function + end interface + real :: x, y + call mysub( glocalb ) ! { dg-error "is recursive" } + return +entry glocalb( x, y ) + y = x +end subroutine +end module +! { dg-final { cleanup-modules "gsub" } } -- 2.7.4