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>
8program 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
18! These two calls replace the previously made call to subroutine
19! set_arrays which was erroneous because of parameter-induced
20! aliasing.
21  call set_array_listpr (listpr)
22  call set_array_lisbit (lisbit)
23
24  if (any (listpr.ne.lischk)) call abort ()
25  call sub1
26  call sub2
27  call sub3
28end
29subroutine sub1
30  common /abc/ mwkx(80)
31  common /cde/ lischk(20)
32  dimension    listpr(20),lisbit(10),lispat(8)
33!     This workaround was OK
34  equivalence (listpr(10),lisbit(1)), &
35              (listpr(10),mwkx(10)),  &
36              (listpr(10),lispat(1))
37  call set_array_listpr (listpr)
38  call set_array_lisbit (lisbit)
39  if (any (listpr .ne. lischk)) call abort ()
40end
41!
42! Equivalences not in COMMON
43!___________________________
44! This gave incorrect results for the same reason as in MAIN.
45subroutine sub2
46  dimension   mwkx(80)
47  common /cde/ lischk(20)
48  dimension    listpr(20),lisbit(10),lispat(8)
49  equivalence (lispat(1),listpr(10)), &
50              (mwkx(10),lisbit(1),listpr(10))
51  call set_array_listpr (listpr)
52  call set_array_lisbit (lisbit)
53  if (any (listpr .ne. lischk)) call abort ()
54end
55! This gave correct results because the order in which the
56! equivalences are taken is different and was given in the PR.
57subroutine sub3
58  dimension   mwkx(80)
59  common /cde/ lischk(20)
60  dimension    listpr(20),lisbit(10),lispat(8)
61  equivalence (listpr(10),lisbit(1),mwkx(10)), &
62              (lispat(1),listpr(10))
63  call set_array_listpr (listpr)
64  call set_array_lisbit (lisbit)
65  if (any (listpr .ne. lischk)) call abort ()
66end
67
68subroutine set_array_listpr (listpr)
69  dimension listpr(20)
70  listpr = 0
71end
72
73subroutine set_array_lisbit (lisbit)
74  dimension lisbit(10)
75  lisbit = (/(i, i = 1, 10)/)
76  lisbit((/3,4/)) = 0
77end
78