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