diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2023-11-03 19:41:54 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2023-11-03 22:11:15 +0100 |
| commit | 5340f48b7639fcc874f64aac214f9ef9ae43d43e (patch) | |
| tree | 5b3b3d3c9afbce140a3d7f8b8886267d69bb4471 /gcc | |
| parent | aed00696a01ac065e9ed327434ec29d1cf50179e (diff) | |
| download | gcc-5340f48b7639fcc874f64aac214f9ef9ae43d43e.zip gcc-5340f48b7639fcc874f64aac214f9ef9ae43d43e.tar.gz gcc-5340f48b7639fcc874f64aac214f9ef9ae43d43e.tar.bz2 | |
Fortran: fix issue with multiple references of a procedure pointer [PR97245]
gcc/fortran/ChangeLog:
PR fortran/97245
* match.cc (gfc_match_call): If a procedure pointer has already been
resolved, do not create a new symbol in a procedure reference of
the same name shadowing the first one if it is host-associated.
gcc/testsuite/ChangeLog:
PR fortran/97245
* gfortran.dg/proc_ptr_53.f90: New test.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/match.cc | 1 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_53.f90 | 35 |
2 files changed, 36 insertions, 0 deletions
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index f848e52..9e3571d 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -5064,6 +5064,7 @@ gfc_match_call (void) right association is made. They are thrown out in resolution.) ... */ if (!sym->attr.generic + && !sym->attr.proc_pointer && !sym->attr.subroutine && !sym->attr.function) { diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_53.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_53.f90 new file mode 100644 index 0000000..29dd08d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_53.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! PR fortran/97245 - ASSOCIATED intrinsic did not recognize a +! pointer variable the second time it is used + +MODULE formulaciones + IMPLICIT NONE + + ABSTRACT INTERFACE + SUBROUTINE proc_void() + END SUBROUTINE proc_void + end INTERFACE + + PROCEDURE(proc_void), POINTER :: pADJSensib => NULL() + +CONTAINS + + subroutine calculo() + PROCEDURE(proc_void), POINTER :: otherprocptr => NULL() + + IF (associated(pADJSensib)) THEN + CALL pADJSensib () + ENDIF + IF (associated(pADJSensib)) THEN ! this was erroneously rejected + CALL pADJSensib () + END IF + + IF (associated(otherprocptr)) THEN + CALL otherprocptr () + ENDIF + IF (associated(otherprocptr)) THEN + CALL otherprocptr () + END IF + end subroutine calculo + +END MODULE formulaciones |