diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/use_only_1.f90 | |
download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/use_only_1.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/use_only_1.f90 | 92 |
1 files changed, 92 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/use_only_1.f90 b/gcc/testsuite/gfortran.dg/use_only_1.f90 new file mode 100644 index 000000000..e01324384 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_only_1.f90 @@ -0,0 +1,92 @@ +! { 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 +! { dg-final { cleanup-modules "xmod ymod" } } |