flang/test/Semantics/equivalence01.f90

   1 !RUN: not %flang_fc1 -pedantic %s 2>&1 | FileCheck %s
   2 subroutine s1
   3   integer i, j
   4   real r(2)
   5   !CHECK: error: Equivalence set must have more than one object
   6   equivalence(i, j),(r(1))
   7 end
   8
   9 subroutine s2
  10   integer i
  11   type t
  12     integer :: a
  13     integer :: b(10)
  14   end type
  15   type(t) :: x
  16   !CHECK: error: Derived type component 'x%a' is not allowed in an equivalence set
  17   equivalence(x%a, i)
  18   !CHECK: error: Derived type component 'x%b(2)' is not allowed in an equivalence set
  19   equivalence(i, x%b(2))
  20 end
  21
  22 integer function f3(x)
  23   real x
  24   !CHECK: error: Dummy argument 'x' is not allowed in an equivalence set
  25   equivalence(i, x)
  26   !CHECK: error: Function result 'f3' is not allow in an equivalence set
  27   equivalence(f3, i)
  28 end
  29
  30 subroutine s4
  31   integer :: y
  32   !CHECK: error: Pointer 'x' is not allowed in an equivalence set
  33   !CHECK: error: Allocatable variable 'y' is not allowed in an equivalence set
  34   equivalence(x, y)
  35   real, pointer :: x
  36   allocatable :: y
  37 end
  38
  39 subroutine s5
  40   integer, parameter :: k = 123
  41   real :: x(10)
  42   real, save :: y[1:*]
  43   !CHECK: error: Coarray 'y' is not allowed in an equivalence set
  44   equivalence(x, y)
  45   !CHECK: error: Variable 'z' with BIND attribute is not allowed in an equivalence set
  46   equivalence(x, z)
  47   !CHECK: error: Variable 'z' with BIND attribute is not allowed in an equivalence set
  48   equivalence(x(2), z(3))
  49   real, bind(C) :: z(10)
  50   !CHECK: error: Named constant 'k' is not allowed in an equivalence set
  51   equivalence(x(2), k)
  52   !CHECK: error: Variable 'w' in common block with BIND attribute is not allowed in an equivalence set
  53   equivalence(x(10), w)
  54   logical :: w(10)
  55   bind(C, name="c") /c/
  56   common /c/ w
  57   integer, target :: u
  58   !CHECK: error: Variable 'u' with TARGET attribute is not allowed in an equivalence set
  59   equivalence(x(1), u)
  60 end
  61
  62 subroutine s6
  63   type t1
  64     sequence
  65     real, pointer :: p
  66   end type
  67   type :: t2
  68     sequence
  69     type(t1) :: b
  70   end type
  71   real :: x0
  72   type(t1) :: x1
  73   type(t2) :: x2
  74   !CHECK: error: Derived type object 'x1' with pointer ultimate component is not allowed in an equivalence set
  75   equivalence(x0, x1)
  76   !CHECK: error: Derived type object 'x2' with pointer ultimate component is not allowed in an equivalence set
  77   equivalence(x0, x2)
  78 end
  79
  80 subroutine s7
  81   type t1
  82   end type
  83   real :: x0
  84   type(t1) :: x1
  85   !CHECK: error: Nonsequence derived type object 'x1' is not allowed in an equivalence set
  86   equivalence(x0, x1)
  87 end
  88
  89 module m8
  90   real :: x
  91   real :: y(10)
  92 end
  93 subroutine s8
  94   use m8
  95   !CHECK: error: Use-associated variable 'x' is not allowed in an equivalence set
  96   equivalence(x, z)
  97   !CHECK: error: Use-associated variable 'y' is not allowed in an equivalence set
  98   equivalence(y(1), z)
  99 end
 100
 101 subroutine s9
 102   character(10) :: c
 103   real :: d(10)
 104   integer, parameter :: n = 2
 105   integer :: i, j
 106   !CHECK: error: Substring with nonconstant bound 'n+j' is not allowed in an equivalence set
 107   equivalence(c(n+1:n+j), i)
 108   !CHECK: error: Substring with zero length is not allowed in an equivalence set
 109   equivalence(c(n:1), i)
 110   !CHECK: error: Array with nonconstant subscript 'j-1' is not allowed in an equivalence set
 111   equivalence(d(j-1), i)
 112   !CHECK: error: Array section 'd(1:n)' is not allowed in an equivalence set
 113   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 unit
 117   equivalence(c, a(10)(2:3))
 118 end
 119
 120 subroutine s10
 121   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 set
 125   equivalence(x(i), y)
 126 end
 127
 128 subroutine s11(n)
 129   integer :: n
 130   real :: x(n), y
 131   !CHECK: error: Automatic object 'x' is not allowed in an equivalence set
 132   equivalence(x(1), y)
 133 end
 134
 135 module s12
 136   real, protected :: a
 137   integer :: b
 138   !CHECK: error: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
 139   equivalence(a, b)
 140   !CHECK: error: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
 141   equivalence(b, a)
 142 end
 143
 144 module s13
 145   logical(8) :: a
 146   character(4) :: b
 147   type :: t1
 148     sequence
 149     complex :: z
 150   end type
 151   type :: t2
 152     sequence
 153     type(t1) :: w
 154   end type
 155   type(t2) :: c
 156   !CHECK: nonstandard: Equivalence set contains 'a' that is numeric sequence type and 'b' that is character
 157   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 kind
 159   equivalence(c, a)
 160   double precision :: d
 161   double complex :: e
 162   !OK: d and e are considered to be a default kind numeric type
 163   equivalence(c, d, e)
 164   type :: t3
 165     sequence
 166     real :: x
 167     character :: ch
 168   end type t3
 169   type(t3) :: s, r
 170   type :: t4
 171     sequence
 172     character :: ch
 173     real :: x
 174   end type t4
 175   type(t4) :: t
 176   !CHECK: nonstandard: Equivalence set contains 's' and 'r' with same type that is neither numeric nor character sequence type
 177   equivalence(s, r)
 178   !CHECK: error: Equivalence set cannot contain 's' and 't' with distinct types that are not both numeric or character sequence types
 179   equivalence(s, t)
 180 end
 181
 182 module s14
 183   real :: a(10), b, c, d
 184   !CHECK: error: 'a(2_8)' and 'a(1_8)' cannot have the same first storage unit
 185   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 unit
 188   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 unit
 191   equivalence(a(6), d)
 192   equivalence(c, d)
 193 end
 194
 195 module s15
 196   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 unit
 199   equivalence(b(2),a(1))
 200 end module
 201
 202 subroutine s16
 203
 204   integer var, dupName
 205
 206   ! There should be no error message for the following
 207   equivalence (dupName, var)
 208
 209   interface
 210     subroutine interfaceSub (dupName)
 211       integer dupName
 212     end subroutine interfaceSub
 213   end interface
 214
 215 end subroutine s16
 216
 217 module m17
 218   real :: dupName
 219 contains
 220   real function f17a()
 221     implicit none
 222     real :: y
 223     !CHECK: error: No explicit type declared for 'dupname'
 224     equivalence (dupName, y)
 225   end function f17a
 226   real function f17b()
 227     real :: y
 228     ! The following implicitly declares an object called "dupName" local to
 229     ! the function f17b().  OK since there's no "implicit none
 230     equivalence (dupName, y)
 231   end function f17b
 232 end module m17
 233
 234 module m18
 235   ! Regression test: don't loop when checking mutually-referencing types
 236   type t1
 237     sequence
 238     type (t2), pointer :: p
 239   end type
 240   type t2
 241     sequence
 242     type (t1), pointer :: p
 243   end type
 244   type(t1) x
 245   common x
 246 end
 247
 248 subroutine s19
 249   entry e19
 250   !ERROR: 'e19' in equivalence set is not a data object
 251   equivalence (e19, j)
 252   !ERROR: 'e20' in equivalence set is not a data object
 253   equivalence (e20, j)
 254   entry e20
 255 end