Hi All, I committed this to 8-branch on 2019-04-24 but not to 9-branch. I have no record of why I did this.
The patch now requires an additional line, && sym->ns->proc_name->attr.proc != PROC_MODULE to prevent the error message in pr88376.f90 from changing to the less helpful Error: Specification function ānā at (1) must be PURE I propose to commit to mainline and backport to 12-branch unless there are objections in the next 24 hours. Cheers Paul Fortran: Recognise external function from within an associate block that has not been declared as external [PR87127] 2023-03-19 Paul Thomas <pa...@gcc.gnu.org> gcc/fortran PR fortran/87127 * resolve.cc (check_host_association): If an external function is typed but not declared explicitly to be external, change the old symbol from a variable to an external function. gcc/testsuite/ PR fortran/87127 * gfortran.dg/external_procedures_4.f90: New test.
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ba603b4c407..a947f908ece 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -6079,11 +6079,14 @@ resolve_procedure: /* Checks to see that the correct symbol has been host associated. - The only situation where this arises is that in which a twice - contained function is parsed after the host association is made. - Therefore, on detecting this, change the symbol in the expression - and convert the array reference into an actual arglist if the old - symbol is a variable. */ + The only situations where this arises are: + (i) That in which a twice contained function is parsed after + the host association is made. On detecting this, change + the symbol in the expression and convert the array reference + into an actual arglist if the old symbol is a variable; or + (ii) That in which an external function is typed but not declared + explcitly to be external. Here, the old symbol is changed + from a variable to an external function. */ static bool check_host_association (gfc_expr *e) { @@ -6185,6 +6188,27 @@ check_host_association (gfc_expr *e) gfc_resolve_expr (e); sym->refs++; } + /* This case corresponds to a call, from a block or a contained + procedure, to an external function, which has not been declared + as being external in the main program but has been typed. */ + else if (sym && old_sym != sym + && !e->ref + && sym->ts.type == BT_UNKNOWN + && old_sym->ts.type != BT_UNKNOWN + && sym->attr.flavor == FL_PROCEDURE + && old_sym->attr.flavor == FL_VARIABLE + && sym->ns->parent == old_sym->ns + && sym->ns->proc_name + && sym->ns->proc_name->attr.proc != PROC_MODULE + && (sym->ns->proc_name->attr.flavor == FL_LABEL + || sym->ns->proc_name->attr.flavor == FL_PROCEDURE)) + { + old_sym->attr.flavor = FL_PROCEDURE; + old_sym->attr.external = 1; + old_sym->attr.function = 1; + old_sym->result = old_sym; + gfc_resolve_expr (e); + } } /* This might have changed! */ return e->expr_type == EXPR_FUNCTION;
! { dg-do run } ! ! Test the fix for PR87127 in which the references to exfunc cause ! the error "exfunc at (1) is not a function". ! ! Contributed by Gerhard Steinmetz <gs...@t-online.de> ! function exfunc(i) implicit none integer :: exfunc,i exfunc = 2*i end function ! contents of test.f90 program test implicit none integer :: exfunc,i integer,parameter :: array(2)=[6,7] associate(i=>array(2)) ! Original bug if (exfunc(i) .ne. 2*i) stop 1 end associate i = 99 call foo contains subroutine foo() ! Comment #3 if (exfunc(i) .ne. 2*i) stop 2 end subroutine foo end program