flang/test/Semantics/resolve63.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Invalid operand types when user-defined operator is available
   3 module m1
   4   type :: t
   5   end type
   6   interface operator(==)
   7     logical function eq_tt(x, y)
   8       import :: t
   9       type(t), intent(in) :: x, y
  10     end
  11   end interface
  12   interface operator(+)
  13     logical function add_tr(x, y)
  14       import :: t
  15       type(t), intent(in) :: x
  16       real, intent(in) :: y
  17     end
  18     logical function plus_t(x)
  19       import :: t
  20       type(t), intent(in) :: x
  21     end
  22     logical function add_12(x, y)
  23       real, intent(in) :: x(:), y(:,:)
  24     end
  25   end interface
  26   interface operator(.and.)
  27     logical function and_tr(x, y)
  28       import :: t
  29       type(t), intent(in) :: x
  30       real, intent(in) :: y
  31     end
  32   end interface
  33   interface operator(//)
  34     logical function concat_tt(x, y)
  35       import :: t
  36       type(t), intent(in) :: x, y
  37     end
  38   end interface
  39   interface operator(.not.)
  40     logical function not_r(x)
  41       real, intent(in) :: x
  42     end
  43   end interface
  44   type(t) :: x, y
  45   real :: r
  46   logical :: l
  47   integer :: iVar
  48   complex :: cvar
  49   character :: charVar
  50 contains
  51   subroutine test_relational()
  52     l = x == y  !OK
  53     l = x .eq. y  !OK
  54     l = x .eq. y  !OK
  55     l = iVar == z'fe' !OK
  56     l = z'fe' == iVar !OK
  57     l = r == z'fe' !OK
  58     l = z'fe' == r !OK
  59     l = cVar == z'fe' !OK
  60     l = z'fe' == cVar !OK
  61     !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types CHARACTER(KIND=1) and INTEGER(4)
  62     l = charVar == z'fe'
  63     !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types INTEGER(4) and CHARACTER(KIND=1)
  64     l = z'fe' == charVar
  65     !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types LOGICAL(4) and INTEGER(4)
  66     l = l == z'fe' !OK
  67     !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types INTEGER(4) and LOGICAL(4)
  68     l = z'fe' == l !OK
  69     !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types TYPE(t) and REAL(4)
  70     l = x == r
  71
  72     lVar = z'a' == b'1010' !OK
  73   end
  74   subroutine test_numeric()
  75     l = x + r  !OK
  76     !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types REAL(4) and TYPE(t)
  77     l = r + x
  78   end
  79   subroutine test_logical()
  80     l = x .and. r  !OK
  81     !ERROR: No intrinsic or user-defined OPERATOR(.AND.) matches operand types REAL(4) and TYPE(t)
  82     l = r .and. x
  83   end
  84   subroutine test_unary()
  85     l = +x  !OK
  86     !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand type LOGICAL(4)
  87     l = +l
  88     l = .not. r  !OK
  89     !ERROR: No intrinsic or user-defined OPERATOR(.NOT.) matches operand type TYPE(t)
  90     l = .not. x
  91   end
  92   subroutine test_concat()
  93     l = x // y  !OK
  94     !ERROR: No intrinsic or user-defined OPERATOR(//) matches operand types TYPE(t) and REAL(4)
  95     l = x // r
  96   end
  97   subroutine test_conformability(x, y)
  98     real :: x(10), y(10,10)
  99     l = x + y  !OK
 100     !ERROR: No intrinsic or user-defined OPERATOR(+) matches rank 2 array of REAL(4) and rank 1 array of REAL(4)
 101     l = y + x
 102   end
 103 end
 104
 105 ! Invalid operand types when user-defined operator is not available
 106 module m2
 107   intrinsic :: sin
 108   type :: t
 109   end type
 110   type(t) :: x, y
 111   real :: r
 112   logical :: l
 113 contains
 114   subroutine test_relational()
 115     !ERROR: Operands of .EQ. must have comparable types; have TYPE(t) and REAL(4)
 116     l = x == r
 117     !ERROR: Subroutine name is not allowed here
 118     l = r == test_numeric
 119     !ERROR: Function call must have argument list
 120     l = r == sin
 121   end
 122   subroutine test_numeric()
 123     !ERROR: Operands of + must be numeric; have REAL(4) and TYPE(t)
 124     l = r + x
 125   end
 126   subroutine test_logical()
 127     !ERROR: Operands of .AND. must be LOGICAL; have REAL(4) and TYPE(t)
 128     l = r .and. x
 129   end
 130   subroutine test_unary()
 131     !ERROR: Operand of unary + must be numeric; have LOGICAL(4)
 132     l = +l
 133     !ERROR: Operand of .NOT. must be LOGICAL; have TYPE(t)
 134     l = .not. x
 135   end
 136   subroutine test_concat(a, b)
 137     character(4,kind=1) :: a
 138     character(4,kind=2) :: b
 139     character(4) :: c
 140     !ERROR: Operands of // must be CHARACTER with the same kind; have CHARACTER(KIND=1) and CHARACTER(KIND=2)
 141     c = a // b
 142     !ERROR: Operands of // must be CHARACTER with the same kind; have TYPE(t) and REAL(4)
 143     l = x // r
 144   end
 145   subroutine test_conformability(x, y)
 146     real :: x(10), y(10,10)
 147     !ERROR: Operands of + are not conformable; have rank 2 and rank 1
 148     l = y + x
 149   end
 150 end
 151
 152 ! Invalid untyped operands: user-defined operator doesn't affect errors
 153 module m3
 154   interface operator(+)
 155     logical function add(x, y)
 156       logical, intent(in) :: x
 157       integer, value :: y
 158     end
 159   end interface
 160 contains
 161   subroutine s1(x, y)
 162     logical :: x
 163     integer :: y
 164     integer, pointer :: px
 165     logical :: l
 166     complex :: z
 167     y = y + z'1'  !OK
 168     !ERROR: Operands of + must be numeric; have untyped and COMPLEX(4)
 169     z = z'1' + z
 170     y = +z'1'  !OK
 171     !ERROR: Operand of unary - must be numeric; have untyped
 172     y = -z'1'
 173     !ERROR: Operands of + must be numeric; have LOGICAL(4) and untyped
 174     y = x + z'1'
 175     !ERROR: A NULL() pointer is not allowed as an operand here
 176     l = x /= null()
 177     !ERROR: A NULL() pointer is not allowed as a relational operand
 178     l = null(px) /= null(px)
 179     !ERROR: A NULL() pointer is not allowed as an operand here
 180     l = x /= null(px)
 181     !ERROR: A NULL() pointer is not allowed as an operand here
 182     l = px /= null()
 183     !ERROR: A NULL() pointer is not allowed as a relational operand
 184     l = px /= null(px)
 185     !ERROR: A NULL() pointer is not allowed as an operand here
 186     l = null() /= null()
 187   end
 188 end
 189
 190 ! Test alternate operators. They aren't enabled by default so should be
 191 ! treated as defined operators, not intrinsic ones.
 192 module m4
 193 contains
 194   subroutine s1(x, y, z)
 195     logical :: x
 196     real :: y, z
 197     !ERROR: No operator .A. defined for REAL(4) and REAL(4)
 198     x = y .a. z
 199     !ERROR: No operator .O. defined for REAL(4) and REAL(4)
 200     x = y .o. z
 201     !ERROR: No operator .N. defined for REAL(4)
 202     x = .n. y
 203     !ERROR: No operator .XOR. defined for REAL(4) and REAL(4)
 204     x = y .xor. z
 205     !ERROR: No operator .X. defined for REAL(4)
 206     x = .x. y
 207   end
 208 end
 209
 210 ! Like m4 in resolve63 but compiled with different options.
 211 ! .A. is a defined operator.
 212 module m5
 213   interface operator(.A.)
 214     logical function f1(x, y)
 215       integer, intent(in) :: x, y
 216     end
 217   end interface
 218   interface operator(.and.)
 219     logical function f2(x, y)
 220       real, intent(in) :: x, y
 221     end
 222   end interface
 223 contains
 224   subroutine s1(x, y, z)
 225     logical :: x
 226     complex :: y, z
 227     !ERROR: No intrinsic or user-defined OPERATOR(.AND.) matches operand types COMPLEX(4) and COMPLEX(4)
 228     x = y .and. z
 229     !ERROR: No intrinsic or user-defined .A. matches operand types COMPLEX(4) and COMPLEX(4)
 230     x = y .a. z
 231   end
 232 end
 233
 234 ! Type-bound operators
 235 module m6
 236   type :: t1
 237   contains
 238     procedure, pass(x) :: p1 => f1
 239     generic :: operator(+) => p1
 240   end type
 241   type, extends(t1) :: t2
 242   contains
 243     procedure, pass(y) :: p2 => f2
 244     generic :: operator(+) => p2
 245   end type
 246   type :: t3
 247   contains
 248     procedure, nopass :: p1 => f1
 249     !ERROR: OPERATOR(+) procedure 'p1' may not have NOPASS attribute
 250     generic :: operator(+) => p1
 251   end type
 252 contains
 253   integer function f1(x, y)
 254     class(t1), intent(in) :: x
 255     integer, intent(in) :: y
 256   end
 257   integer function f2(x, y)
 258     class(t1), intent(in) :: x
 259     class(t2), intent(in) :: y
 260   end
 261   subroutine test(x, y, z)
 262     class(t1) :: x
 263     class(t2) :: y
 264     integer :: i
 265     i = x + y
 266     i = x + i
 267     i = y + i
 268     !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types TYPE(t2) and TYPE(t1)
 269     i = y + x
 270     !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types INTEGER(4) and TYPE(t1)
 271     i = i + x
 272   end
 273 end
 274
 275 ! Some cases where NULL is acceptable - ensure no false errors
 276 module m7
 277   implicit none
 278   type :: t1
 279    contains
 280     procedure :: s1
 281     generic :: operator(/) => s1
 282   end type
 283   interface operator(-)
 284     module procedure s2
 285   end interface
 286  contains
 287   integer function s1(x, y)
 288     class(t1), intent(in) :: x
 289     class(t1), intent(in), pointer :: y
 290     s1 = 1
 291   end
 292   integer function s2(x, y)
 293     type(t1), intent(in), pointer :: x, y
 294     s2 = 2
 295   end
 296   subroutine test
 297     integer :: j
 298     type(t1), pointer :: x1
 299     allocate(x1)
 300     ! These cases are fine.
 301     j = x1 - x1
 302     j = x1 - null(mold=x1)
 303     j = null(mold=x1) - null(mold=x1)
 304     j = null(mold=x1) - x1
 305     j = x1 / x1
 306     j = x1 / null(mold=x1)
 307     j = null() - null(mold=x1)
 308     j = null(mold=x1) - null()
 309     j = null() - null()
 310     !ERROR: No intrinsic or user-defined OPERATOR(/) matches operand types untyped and TYPE(t1)
 311     j = null() / null(mold=x1)
 312     !ERROR: No intrinsic or user-defined OPERATOR(/) matches operand types TYPE(t1) and untyped
 313     j = null(mold=x1) / null()
 314     !ERROR: A NULL() pointer is not allowed as an operand here
 315     j = null() / null()
 316   end
 317 end
 318
 319 ! 16.9.144(6)
 320 module m8
 321   interface generic
 322     procedure s1, s2
 323   end interface
 324  contains
 325   subroutine s1(ip1, rp1)
 326     integer, pointer, intent(in) :: ip1
 327     real, pointer, intent(in) :: rp1
 328   end subroutine
 329   subroutine s2(rp2, ip2)
 330     real, pointer, intent(in) :: rp2
 331     integer, pointer, intent(in) :: ip2
 332   end subroutine
 333   subroutine test
 334     integer, pointer :: ip
 335     real, pointer :: rp
 336     call generic(ip, rp) ! ok
 337     call generic(ip, null()) ! ok
 338     call generic(rp, null()) ! ok
 339     call generic(null(), rp) ! ok
 340     call generic(null(), ip) ! ok
 341     call generic(null(mold=ip), null()) ! ok
 342     call generic(null(), null(mold=ip)) ! ok
 343     !ERROR: One or more NULL() actual arguments to the generic procedure 'generic' requires a MOLD= for disambiguation
 344     call generic(null(), null())
 345   end subroutine
 346 end