OSDN Git Service

2006-02-24 Paul Thomas <pault@gcc.gnu.org>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / equiv_6.f90
1 ! { dg-do run }
2 ! This checks the patch for PR25395, in which equivalences within one
3 ! segment were broken by indirect equivalences, depending on the
4 ! offset of the variable that bridges the indirect equivalence.
5 !
6 ! This is a fortran95 version of the original testcase, which was
7 ! contributed by Harald Vogt  <harald.vogt@desy.de>
8 program check_6
9   common /abc/ mwkx(80)
10   common /cde/ lischk(20)
11   dimension    listpr(20),lisbit(10),lispat(8)
12 ! This was badly compiled in the PR:
13   equivalence (listpr(10),lisbit(1),mwkx(10)), &
14               (lispat(1),listpr(10))
15   lischk = (/0, 0, 0, 0, 0, 0, 0, 0, 0, 1, &
16              2, 0, 0, 5, 6, 7, 8, 9,10, 0/)
17   call set_arrays (listpr, lisbit)
18   if (any (listpr.ne.lischk)) call abort ()
19   call sub1
20   call sub2
21   call sub3
22 end
23 subroutine sub1
24   common /abc/ mwkx(80)
25   common /cde/ lischk(20)
26   dimension    listpr(20),lisbit(10),lispat(8)
27 !     This workaround was OK
28   equivalence (listpr(10),lisbit(1)), &
29               (listpr(10),mwkx(10)),  &
30               (listpr(10),lispat(1))
31   call set_arrays (listpr, lisbit)
32   if (any (listpr .ne. lischk)) call abort ()
33 end
34 !
35 ! Equivalences not in COMMON
36 !___________________________
37 ! This gave incorrect results for the same reason as in MAIN.
38 subroutine sub2
39   dimension   mwkx(80)
40   common /cde/ lischk(20)
41   dimension    listpr(20),lisbit(10),lispat(8)
42   equivalence (lispat(1),listpr(10)), &
43               (mwkx(10),lisbit(1),listpr(10))
44   call set_arrays (listpr, lisbit)
45   if (any (listpr .ne. lischk)) call abort ()
46 end
47 ! This gave correct results because the order in which the
48 ! equivalences are taken is different and was given in the PR.
49 subroutine sub3
50   dimension   mwkx(80)
51   common /cde/ lischk(20)
52   dimension    listpr(20),lisbit(10),lispat(8)
53   equivalence (listpr(10),lisbit(1),mwkx(10)), &
54               (lispat(1),listpr(10))
55   call set_arrays (listpr, lisbit)
56   if (any (listpr .ne. lischk)) call abort ()
57 end
58 subroutine set_arrays (listpr, lisbit)
59   dimension listpr(20),lisbit(10)
60   listpr = 0
61   lisbit = (/(i, i = 1, 10)/)
62   lisbit((/3,4/)) = 0
63 end