===================================================================
*************** 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. */
static bool
check_host_association (gfc_expr *e)
{
/* Checks to see that the correct symbol has been host associated.
! 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
! explicitly to be external. Here, the old symbol is changed
! from a variable to an external function. */
static bool
check_host_association (gfc_expr *e)
{
*************** 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.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 <gscfq@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
This patch is pretty self-explanatory. I have checked that a sensible errors are given if 'exfunc' in the testcase is referenced if it is a variable. Bootstrapped and regtested on FC29/x86_64 - OK for trunk? Paul 2019-03-30 Paul Thomas <pault@gcc.gnu.org> PR fortran/87127 * resolve.c (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. 2019-03-30 Paul Thomas <pault@gcc.gnu.org> PR fortran/87127 * gfortran.dg/external_procedures_4.f90: New test.