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;
}
--- /dev/null
+! { 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