summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/equiv_6.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/equiv_6.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/equiv_6.f90')
-rw-r--r--gcc/testsuite/gfortran.dg/equiv_6.f9077
1 files changed, 77 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/equiv_6.f90 b/gcc/testsuite/gfortran.dg/equiv_6.f90
new file mode 100644
index 000000000..1ab1a0513
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_6.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! This checks the patch for PR25395, in which equivalences within one
+! segment were broken by indirect equivalences, depending on the
+! offset of the variable that bridges the indirect equivalence.
+!
+! This is a fortran95 version of the original testcase, which was
+! contributed by Harald Vogt <harald.vogt@desy.de>
+program check_6
+ common /abc/ mwkx(80)
+ common /cde/ lischk(20)
+ dimension listpr(20),lisbit(10),lispat(8)
+! This was badly compiled in the PR:
+ equivalence (listpr(10),lisbit(1),mwkx(10)), &
+ (lispat(1),listpr(10))
+ lischk = (/0, 0, 0, 0, 0, 0, 0, 0, 0, 1, &
+ 2, 0, 0, 5, 6, 7, 8, 9,10, 0/)
+
+! These two calls replace the previously made call to subroutine
+! set_arrays which was erroneous because of parameter-induced
+! aliasing.
+ call set_array_listpr (listpr)
+ call set_array_lisbit (lisbit)
+
+ if (any (listpr.ne.lischk)) call abort ()
+ call sub1
+ call sub2
+ call sub3
+end
+subroutine sub1
+ common /abc/ mwkx(80)
+ common /cde/ lischk(20)
+ dimension listpr(20),lisbit(10),lispat(8)
+! This workaround was OK
+ equivalence (listpr(10),lisbit(1)), &
+ (listpr(10),mwkx(10)), &
+ (listpr(10),lispat(1))
+ call set_array_listpr (listpr)
+ call set_array_lisbit (lisbit)
+ if (any (listpr .ne. lischk)) call abort ()
+end
+!
+! Equivalences not in COMMON
+!___________________________
+! This gave incorrect results for the same reason as in MAIN.
+subroutine sub2
+ dimension mwkx(80)
+ common /cde/ lischk(20)
+ dimension listpr(20),lisbit(10),lispat(8)
+ equivalence (lispat(1),listpr(10)), &
+ (mwkx(10),lisbit(1),listpr(10))
+ call set_array_listpr (listpr)
+ call set_array_lisbit (lisbit)
+ if (any (listpr .ne. lischk)) call abort ()
+end
+! This gave correct results because the order in which the
+! equivalences are taken is different and was given in the PR.
+subroutine sub3
+ dimension mwkx(80)
+ common /cde/ lischk(20)
+ dimension listpr(20),lisbit(10),lispat(8)
+ equivalence (listpr(10),lisbit(1),mwkx(10)), &
+ (lispat(1),listpr(10))
+ call set_array_listpr (listpr)
+ call set_array_lisbit (lisbit)
+ if (any (listpr .ne. lischk)) call abort ()
+end
+
+subroutine set_array_listpr (listpr)
+ dimension listpr(20)
+ listpr = 0
+end
+
+subroutine set_array_lisbit (lisbit)
+ dimension lisbit(10)
+ lisbit = (/(i, i = 1, 10)/)
+ lisbit((/3,4/)) = 0
+end