summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/use_only_1.f90
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/use_only_1.f90
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.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.f9092
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" } }