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