1! { dg-do run } 2! { dg-options "-O1" } 3! Checks the fix for PR33541, in which a requirement of 4! F95 11.3.2 was not being met: The local names 'x' and 5! 'y' coming from the USE statements without an ONLY clause 6! should not survive in the presence of the locally renamed 7! versions. In fixing the PR, the same correction has been 8! made to generic interfaces. 9! 10! Reported by Reported by John Harper in 11! http://gcc.gnu.org/ml/fortran/2007-09/msg00397.html 12! 13MODULE xmod 14 integer(4) :: x = -666 15 private foo, bar 16 interface xfoobar 17 module procedure foo, bar 18 end interface 19contains 20 integer function foo () 21 foo = 42 22 end function 23 integer function bar (a) 24 integer a 25 bar = a 26 end function 27END MODULE xmod 28 29MODULE ymod 30 integer(4) :: y = -666 31 private foo, bar 32 interface yfoobar 33 module procedure foo, bar 34 end interface 35contains 36 integer function foo () 37 foo = 42 38 end function 39 integer function bar (a) 40 integer a 41 bar = a 42 end function 43END MODULE ymod 44 45 integer function xfoobar () ! These function as defaults should... 46 xfoobar = 99 47 end function 48 49 integer function yfoobar () ! ...the rename works correctly. 50 yfoobar = 99 51 end function 52 53PROGRAM test2uses 54 implicit integer(2) (a-z) 55 x = 666 ! These assignments generate implicitly typed 56 y = 666 ! local variables 'x' and 'y'. 57 call test1 58 call test2 59 call test3 60contains 61 subroutine test1 ! Test the fix of the original PR 62 USE xmod 63 USE xmod, ONLY: xrenamed => x 64 USE ymod, ONLY: yrenamed => y 65 USE ymod 66 implicit integer(2) (a-z) 67 if (kind(xrenamed) == kind(x)) call abort () 68 if (kind(yrenamed) == kind(y)) call abort () 69 end subroutine 70 71 subroutine test2 ! Test the fix applies to generic interfaces 72 USE xmod 73 USE xmod, ONLY: xfoobar_renamed => xfoobar 74 USE ymod, ONLY: yfoobar_renamed => yfoobar 75 USE ymod 76 implicit integer(4) (a-z) 77 if (xfoobar_renamed (42) == xfoobar ()) call abort () 78 if (yfoobar_renamed (42) == yfoobar ()) call abort () 79 end subroutine 80 81 subroutine test3 ! Check that USE_NAME == LOCAL_NAME is OK 82 USE xmod 83 USE xmod, ONLY: x => x, xfoobar => xfoobar 84 USE ymod, ONLY: y => y, yfoobar => yfoobar 85 USE ymod 86 if (kind (x) /= 4) call abort () 87 if (kind (y) /= 4) call abort () 88 if (xfoobar (77) /= 77_4) call abort () 89 if (yfoobar (77) /= 77_4) call abort () 90 end subroutine 91END PROGRAM test2uses 92