1! { dg-do run } 2! 3! PR fortran/45900 4! The BTYPEINSTANCE%CALLBACK() typebound call was resolved incorrectly to 5! A's CALLBACK procedure instead of B's because the CALLBACK name is ambiguous 6! in the MAIN namespace. 7! 8! Original testcase by someone <ortp21@gmail.com> 9 10module A 11implicit none 12 type :: aType 13 contains 14 procedure :: callback 15 end type aType 16 contains 17 subroutine callback( callback_, i ) 18 implicit none 19 class(aType) :: callback_ 20 integer :: i 21 22 i = 3 23 end subroutine callback 24 25 subroutine solver( callback_, i ) 26 implicit none 27 class(aType) :: callback_ 28 integer :: i 29 30 call callback_%callback(i) 31 end subroutine solver 32end module A 33 34module B 35use A, only: aType 36implicit none 37 type, extends(aType) :: bType 38 integer :: i 39 contains 40 procedure :: callback 41 end type bType 42 contains 43 subroutine callback( callback_, i ) 44 implicit none 45 class(bType) :: callback_ 46 integer :: i 47 48 i = 7 49 end subroutine callback 50end module B 51 52program main 53 call test1() 54 call test2() 55 56contains 57 58 subroutine test1 59 use A 60 use B 61 implicit none 62 type(aType) :: aTypeInstance 63 type(bType) :: bTypeInstance 64 integer :: iflag 65 66 bTypeInstance%i = 4 67 68 iflag = 0 69 call bTypeInstance%callback(iflag) 70 if (iflag /= 7) STOP 1 71 iflag = 1 72 call solver( bTypeInstance, iflag ) 73 if (iflag /= 7) STOP 2 74 75 iflag = 2 76 call aTypeInstance%callback(iflag) 77 if (iflag /= 3) STOP 3 78 end subroutine test1 79 80 subroutine test2 81 use B 82 use A 83 implicit none 84 type(aType) :: aTypeInstance 85 type(bType) :: bTypeInstance 86 integer :: iflag 87 88 bTypeInstance%i = 4 89 90 iflag = 0 91 call bTypeInstance%callback(iflag) 92 if (iflag /= 7) STOP 4 93 iflag = 1 94 call solver( bTypeInstance, iflag ) 95 if (iflag /= 7) STOP 5 96 97 iflag = 2 98 call aTypeInstance%callback(iflag) 99 if (iflag /= 3) STOP 6 100 end subroutine test2 101end program main 102 103 104