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