flang/test/Semantics/equivalence01.f90

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