[Patch, fortran] PR87127 - External function not recognised from within an associate block

[Patch, fortran] PR87127 - External function not recognised from within an associate block

[Paul Richard Thomas]

[-- Attachment #1.1: Type: text/plain, Size: 961 bytes --]

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  <pault@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.

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 2167 bytes --]

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;

[-- Attachment #3: external_procedures_4.f90 --]
[-- Type: text/x-fortran, Size: 638 bytes --]

! { 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

Re: [Patch, fortran] PR87127 - External function not recognised from within an associate block

[Paul Richard Thomas]

Hi Dominique,

I discovered the same thing myself this morning. The patch was
developed on 8-branch because my working trunk had a hefty patch in an
intermediate state of development. I cleared it off,ready to do the
commit, and discovered the change on regtesting. I am trying to think
of a way in which to distinguish the two cases.

Thanks

Paul

On Sun, 31 Mar 2019 at 10:33, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
>
> Hi Paul,
>
> With your patch the error for the test gfortran.dg/pr88376.f90 is changed from
>
> Error: 'n' at (1) is not a function
>
> to
>
> Error: Specification function 'n' at (1) must be PURE
>
> TIA
>
> Dominique



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: [Patch, fortran] PR87127 - External function not recognised from within an associate block

[Dominique d'Humières]

Hi Paul,

With your patch the error for the test gfortran.dg/pr88376.f90 is changed from

Error: 'n' at (1) is not a function

to

Error: Specification function 'n' at (1) must be PURE

TIA

Dominique

Re: [Patch, fortran] PR87127 - External function not recognised from within an associate block

[Thomas Koenig]

Hi Paul,

> Bootstrapped and regtested on FC29/x86_64 - OK for trunk?

OK - looks obvious enough, and, IMO, is quite unlikely to cause
a regressions.

Thanks for the patch!

Regards

	Thomas

[Patch, fortran] PR87127 - External function not recognised from within an associate block

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 596 bytes --]

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.

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 3374 bytes --]

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 269160)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_procedure:
*** 5615,5625 ****


  /* 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)
  {
--- 5615,5628 ----


  /* 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)
*** 5709,5714 ****
--- 5712,5737 ----
  	  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;
Index: gcc/testsuite/gfortran.dg/external_procedures_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/external_procedures_4.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/external_procedures_4.f90	(working copy)
***************
*** 0 ****
--- 1,28 ----
+ ! { 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