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: Operands of .EQ. must have comparable types; have CHARACTER(KIND=1) and INTEGER(4)
  62     l = charVar == z'fe'
  63     !ERROR: Operands of .EQ. must have comparable types; have INTEGER(4) and CHARACTER(KIND=1)
  64     l = z'fe' == charVar
  65     !ERROR: Operands of .EQ. must have comparable types; have LOGICAL(4) and INTEGER(4)
  66     l = l == z'fe'
  67     !ERROR: Operands of .EQ. must have comparable types; have INTEGER(4) and LOGICAL(4)
  68     l = z'fe' == l
  69     !ERROR: Operands of .EQ. must have comparable types; have 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: Operands of + must be numeric; have CLASS(t2) and CLASS(t1)
 269     i = y + x
 270     !ERROR: Operands of + must be numeric; have INTEGER(4) and CLASS(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: A NULL() pointer is not allowed as an operand here
 311     j = null() / null(mold=x1)
 312     !ERROR: A NULL() pointer is not allowed as an operand here
 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 actual arguments to the generic procedure 'generic' matched multiple specific procedures, perhaps due to use of NULL() without MOLD= or an actual procedure with an implicit interface
 344     call generic(null(), null())
 345   end subroutine
 346 end
 347
 348 module m9
 349   interface generic
 350     procedure s1, s2
 351   end interface
 352  contains
 353   subroutine s1(jf)
 354     procedure(integer) :: jf
 355   end subroutine
 356   subroutine s2(af)
 357     procedure(real) :: af
 358   end subroutine
 359   subroutine test
 360     external underspecified
 361     !ERROR: One or more actual arguments to the generic procedure 'generic' matched multiple specific procedures, perhaps due to use of NULL() without MOLD= or an actual procedure with an implicit interface
 362     call generic(underspecified)
 363   end subroutine
 364 end module
 365
 366 ! Ensure no bogus errors for assignments to CLASS(*) allocatable
 367 module m10
 368   type :: t1
 369     integer :: n
 370   end type
 371  contains
 372   subroutine test
 373     class(*), allocatable :: poly
 374     poly = 1
 375     poly = 3.14159
 376     poly = 'Il faut imaginer Sisyphe heureux'
 377     poly = t1(1)
 378   end subroutine
 379 end module