[gcc r16-1633] Fortran: fix checking of renamed-on-use interface name [PR120784]
Harald Anlauf
anlauf@gcc.gnu.org
Mon Jun 23 20:42:26 GMT 2025
https://gcc.gnu.org/g:6dd1659cf10a7ad51576f902ef3bc007db30c990
commit r16-1633-g6dd1659cf10a7ad51576f902ef3bc007db30c990
Author: Harald Anlauf <anlauf@gmx.de>
Date: Mon Jun 23 21:33:40 2025 +0200
Fortran: fix checking of renamed-on-use interface name [PR120784]
PR fortran/120784
gcc/fortran/ChangeLog:
* interface.cc (gfc_match_end_interface): If a use-associated
symbol is renamed, use the local_name for checking.
gcc/testsuite/ChangeLog:
* gfortran.dg/interface_63.f90: New test.
Diff:
---
gcc/fortran/interface.cc | 13 +++++--
gcc/testsuite/gfortran.dg/interface_63.f90 | 62 ++++++++++++++++++++++++++++++
2 files changed, 72 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index b8542920ce79..cdb838d83368 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -452,11 +452,18 @@ gfc_match_end_interface (void)
case INTERFACE_DTIO:
case INTERFACE_GENERIC:
+ /* If a use-associated symbol is renamed, check the local_name. */
+ const char *local_name = current_interface.sym->name;
+
+ if (current_interface.sym->attr.use_assoc
+ && current_interface.sym->attr.use_rename
+ && current_interface.sym->ns->use_stmts->rename)
+ local_name = current_interface.sym->ns->use_stmts->rename->local_name;
+
if (type != current_interface.type
- || strcmp (current_interface.sym->name, name) != 0)
+ || strcmp (local_name, name) != 0)
{
- gfc_error ("Expecting %<END INTERFACE %s%> at %C",
- current_interface.sym->name);
+ gfc_error ("Expecting %<END INTERFACE %s%> at %C", local_name);
m = MATCH_ERROR;
}
diff --git a/gcc/testsuite/gfortran.dg/interface_63.f90 b/gcc/testsuite/gfortran.dg/interface_63.f90
new file mode 100644
index 000000000000..a55e8ab431b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_63.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! PR fortran/120784 - fix checking of renamed-on-use interface name
+!
+! Contributed by Matt Thompson <matthew.thompson at nasa dot gov>
+
+module A_mod
+ implicit none
+
+ interface Get
+ procedure :: get_1
+ procedure :: get_2
+ end interface Get
+
+contains
+
+ subroutine get_1(i)
+ integer :: i
+ i = 5
+ end subroutine get_1
+
+ subroutine get_2(x)
+ real :: x
+ x = 4
+ end subroutine get_2
+end module A_mod
+
+module B_mod
+ use A_mod, only : MyGet => Get
+ implicit none
+
+ interface MyGet
+ procedure :: other_get
+ end interface MyGet
+
+contains
+
+ subroutine other_get(c)
+ character(1) :: c
+ c = 'a'
+ end subroutine other_get
+
+ subroutine check_get ()
+ character :: c
+ integer :: i
+ real :: r
+ call myget (c)
+ call myget (i)
+ call myget (r)
+ end subroutine check_get
+
+end module B_MOD
+
+program p
+ use b_mod, only: myget
+ implicit none
+ character :: c
+ integer :: i
+ real :: r
+ call myget (c)
+ call myget (i)
+ call myget (r)
+end
More information about the Gcc-cvs
mailing list