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 --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index b8542920ce79efeeb061294cac0f90aca36f4442..cdb838d8336895bee3f04aeac21f5cc26cf1072a 100644 (file)
--- 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 (file)
index 0000000..a55e8ab
--- /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