256 lines · plain
1!RUN: not %flang_fc1 -pedantic %s 2>&1 | FileCheck %s2subroutine s13 integer i, j4 real r(2)5 !CHECK: error: Equivalence set must have more than one object6 equivalence(i, j),(r(1))7end8 9subroutine s210 integer i11 type t12 integer :: a13 integer :: b(10)14 end type15 type(t) :: x16 !CHECK: error: Derived type component 'x%a' is not allowed in an equivalence set17 equivalence(x%a, i)18 !CHECK: error: Derived type component 'x%b(2)' is not allowed in an equivalence set19 equivalence(i, x%b(2))20end21 22integer function f3(x)23 real x24 !CHECK: error: Dummy argument 'x' is not allowed in an equivalence set25 equivalence(i, x)26 !CHECK: error: Function result 'f3' is not allow in an equivalence set27 equivalence(f3, i)28end29 30subroutine s431 integer :: y32 !CHECK: error: Pointer 'x' is not allowed in an equivalence set33 !CHECK: error: Allocatable variable 'y' is not allowed in an equivalence set34 equivalence(x, y)35 real, pointer :: x36 allocatable :: y37end38 39subroutine s540 integer, parameter :: k = 12341 real :: x(10)42 real, save :: y[1:*]43 !CHECK: error: Coarray 'y' is not allowed in an equivalence set44 equivalence(x, y)45 !CHECK: error: Variable 'z' with BIND attribute is not allowed in an equivalence set46 equivalence(x, z)47 !CHECK: error: Variable 'z' with BIND attribute is not allowed in an equivalence set48 equivalence(x(2), z(3))49 real, bind(C) :: z(10)50 !CHECK: error: Named constant 'k' is not allowed in an equivalence set51 equivalence(x(2), k)52 !CHECK: error: Variable 'w' in common block with BIND attribute is not allowed in an equivalence set53 equivalence(x(10), w)54 logical :: w(10)55 bind(C, name="c") /c/56 common /c/ w57 integer, target :: u58 !CHECK: error: Variable 'u' with TARGET attribute is not allowed in an equivalence set59 equivalence(x(1), u)60end61 62subroutine s663 type t164 sequence65 real, pointer :: p66 end type67 type :: t268 sequence69 type(t1) :: b70 end type71 real :: x072 type(t1) :: x173 type(t2) :: x274 !CHECK: error: Derived type object 'x1' with pointer ultimate component is not allowed in an equivalence set75 equivalence(x0, x1)76 !CHECK: error: Derived type object 'x2' with pointer ultimate component is not allowed in an equivalence set77 equivalence(x0, x2)78end79 80subroutine s781 type t182 end type83 real :: x084 type(t1) :: x185 !CHECK: error: Nonsequence derived type object 'x1' is not allowed in an equivalence set86 equivalence(x0, x1)87end88 89module m890 real :: x91 real :: y(10)92end93subroutine s894 use m895 !CHECK: error: Use-associated variable 'x' is not allowed in an equivalence set96 equivalence(x, z)97 !CHECK: error: Use-associated variable 'y' is not allowed in an equivalence set98 equivalence(y(1), z)99end100 101subroutine s9102 character(10) :: c103 real :: d(10)104 integer, parameter :: n = 2105 integer :: i, j106 !CHECK: error: Substring with nonconstant bound 'n+j' is not allowed in an equivalence set107 equivalence(c(n+1:n+j), i)108 !CHECK: error: Substring with zero length is not allowed in an equivalence set109 equivalence(c(n:1), i)110 !CHECK: error: Array with nonconstant subscript 'j-1' is not allowed in an equivalence set111 equivalence(d(j-1), i)112 !CHECK: error: Array section 'd(1:n)' is not allowed in an equivalence set113 equivalence(d(1:n), i)114 character(4) :: a(10)115 equivalence(c, a(10)(1:2))116 !CHECK: error: 'a(10_8)(2_8:2_8)' and 'a(10_8)(1_8:1_8)' cannot have the same first storage unit117 equivalence(c, a(10)(2:3))118end119 120subroutine s10121 integer, parameter :: i(4) = [1, 2, 3, 4]122 real :: x(10)123 real :: y(4)124 !CHECK: error: Array with vector subscript 'i' is not allowed in an equivalence set125 equivalence(x(i), y)126end127 128subroutine s11(n)129 integer :: n130 real :: x(n), y131 !CHECK: error: Automatic object 'x' is not allowed in an equivalence set132 equivalence(x(1), y)133end134 135module s12136 real, protected :: a137 integer :: b138 !CHECK: error: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without139 equivalence(a, b)140 !CHECK: error: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without141 equivalence(b, a)142end143 144module s13145 logical(8) :: a146 character(4) :: b147 type :: t1148 sequence149 complex :: z150 end type151 type :: t2152 sequence153 type(t1) :: w154 end type155 type(t2) :: c156 !CHECK: nonstandard: Equivalence set contains 'a' that is numeric sequence type and 'b' that is character157 equivalence(a, b)158 !CHECK: nonstandard: Equivalence set contains 'c' that is a default numeric sequence type and 'a' that is numeric with non-default kind159 equivalence(c, a)160 double precision :: d161 double complex :: e162 !OK: d and e are considered to be a default kind numeric type163 equivalence(c, d, e)164 type :: t3165 sequence166 real :: x167 character :: ch168 end type t3169 type(t3) :: s, r170 type :: t4171 sequence172 character :: ch173 real :: x174 end type t4175 type(t4) :: t176 !CHECK: nonstandard: Equivalence set contains 's' and 'r' with same type that is neither numeric nor character sequence type177 equivalence(s, r)178 !CHECK: error: Equivalence set cannot contain 's' and 't' with distinct types that are not both numeric or character sequence types179 equivalence(s, t)180end181 182module s14183 real :: a(10), b, c, d184 !CHECK: error: 'a(2_8)' and 'a(1_8)' cannot have the same first storage unit185 equivalence(a(1), a(2))186 equivalence(b, a(3))187 !CHECK: error: 'a(4_8)' and 'a(3_8)' cannot have the same first storage unit188 equivalence(a(4), b)189 equivalence(c, a(5))190 !CHECK: error: 'a(6_8)' and 'a(5_8)' cannot have the same first storage unit191 equivalence(a(6), d)192 equivalence(c, d)193end194 195module s15196 real :: a(2), b(2)197 equivalence(a(2),b(1))198 !CHECK: error: 'a(3_8)' and 'a(1_8)' cannot have the same first storage unit199 equivalence(b(2),a(1))200end module201 202subroutine s16203 204 integer var, dupName205 206 ! There should be no error message for the following207 equivalence (dupName, var)208 209 interface210 subroutine interfaceSub (dupName)211 integer dupName212 end subroutine interfaceSub213 end interface214 215end subroutine s16216 217module m17218 real :: dupName219contains220 real function f17a()221 implicit none222 real :: y223 !CHECK: error: No explicit type declared for 'dupname'224 equivalence (dupName, y)225 end function f17a226 real function f17b()227 real :: y228 ! The following implicitly declares an object called "dupName" local to229 ! the function f17b(). OK since there's no "implicit none230 equivalence (dupName, y)231 end function f17b232end module m17233 234module m18235 ! Regression test: don't loop when checking mutually-referencing types236 type t1237 sequence238 type (t2), pointer :: p239 end type240 type t2241 sequence242 type (t1), pointer :: p243 end type244 type(t1) x245 common x246end247 248subroutine s19249 entry e19250 !ERROR: 'e19' in equivalence set is not a data object251 equivalence (e19, j)252 !ERROR: 'e20' in equivalence set is not a data object253 equivalence (e20, j)254 entry e20255end256