test/Semantics/resolve63.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
! Invalid operand types when user-defined operator is available
module m1
  type :: t
  end type
  interface operator(==)
    logical function eq_tt(x, y)
      import :: t
      type(t), intent(in) :: x, y
    end
  end interface
  interface operator(+)
    logical function add_tr(x, y)
      import :: t
      type(t), intent(in) :: x
      real, intent(in) :: y
    end
    logical function plus_t(x)
      import :: t
      type(t), intent(in) :: x
    end
    logical function add_12(x, y)
      real, intent(in) :: x(:), y(:,:)
    end
  end interface
  interface operator(.and.)
    logical function and_tr(x, y)
      import :: t
      type(t), intent(in) :: x
      real, intent(in) :: y
    end
  end interface
  interface operator(//)
    logical function concat_tt(x, y)
      import :: t
      type(t), intent(in) :: x, y
    end
  end interface
  interface operator(.not.)
    logical function not_r(x)
      real, intent(in) :: x
    end
  end interface
  type(t) :: x, y
  real :: r
  logical :: l
  integer :: iVar
  complex :: cvar
  character :: charVar
contains
  subroutine test_relational()
    l = x == y  !OK
    l = x .eq. y  !OK
    l = x .eq. y  !OK
    l = iVar == z'fe' !OK
    l = z'fe' == iVar !OK
    l = r == z'fe' !OK
    l = z'fe' == r !OK
    l = cVar == z'fe' !OK
    l = z'fe' == cVar !OK
    !ERROR: Operands of .EQ. must have comparable types; have CHARACTER(KIND=1) and INTEGER(4)
    l = charVar == z'fe'
    !ERROR: Operands of .EQ. must have comparable types; have INTEGER(4) and CHARACTER(KIND=1)
    l = z'fe' == charVar
    !ERROR: Operands of .EQ. must have comparable types; have LOGICAL(4) and INTEGER(4)
    l = l == z'fe'
    !ERROR: Operands of .EQ. must have comparable types; have INTEGER(4) and LOGICAL(4)
    l = z'fe' == l
    !ERROR: Operands of .EQ. must have comparable types; have TYPE(t) and REAL(4)
    l = x == r

    lVar = z'a' == b'1010' !OK
  end
  subroutine test_numeric()
    l = x + r  !OK
    !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types REAL(4) and TYPE(t)
    l = r + x
  end
  subroutine test_logical()
    l = x .and. r  !OK
    !ERROR: No intrinsic or user-defined OPERATOR(.AND.) matches operand types REAL(4) and TYPE(t)
    l = r .and. x
  end
  subroutine test_unary()
    l = +x  !OK
    !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand type LOGICAL(4)
    l = +l
    l = .not. r  !OK
    !ERROR: No intrinsic or user-defined OPERATOR(.NOT.) matches operand type TYPE(t)
    l = .not. x
  end
  subroutine test_concat()
    l = x // y  !OK
    !ERROR: No intrinsic or user-defined OPERATOR(//) matches operand types TYPE(t) and REAL(4)
    l = x // r
  end
  subroutine test_conformability(x, y)
    real :: x(10), y(10,10)
    l = x + y  !OK
    !ERROR: No intrinsic or user-defined OPERATOR(+) matches rank 2 array of REAL(4) and rank 1 array of REAL(4)
    l = y + x
  end
end

! Invalid operand types when user-defined operator is not available
module m2
  intrinsic :: sin
  type :: t
  end type
  type(t) :: x, y
  real :: r
  logical :: l
contains
  subroutine test_relational()
    !ERROR: Operands of .EQ. must have comparable types; have TYPE(t) and REAL(4)
    l = x == r
    !ERROR: Subroutine name is not allowed here
    l = r == test_numeric
    !ERROR: Function call must have argument list
    l = r == sin
  end
  subroutine test_numeric()
    !ERROR: Operands of + must be numeric; have REAL(4) and TYPE(t)
    l = r + x
  end
  subroutine test_logical()
    !ERROR: Operands of .AND. must be LOGICAL; have REAL(4) and TYPE(t)
    l = r .and. x
  end
  subroutine test_unary()
    !ERROR: Operand of unary + must be numeric; have LOGICAL(4)
    l = +l
    !ERROR: Operand of .NOT. must be LOGICAL; have TYPE(t)
    l = .not. x
  end
  subroutine test_concat(a, b)
    character(4,kind=1) :: a
    character(4,kind=2) :: b
    character(4) :: c
    !ERROR: Operands of // must be CHARACTER with the same kind; have CHARACTER(KIND=1) and CHARACTER(KIND=2)
    c = a // b
    !ERROR: Operands of // must be CHARACTER with the same kind; have TYPE(t) and REAL(4)
    l = x // r
  end
  subroutine test_conformability(x, y)
    real :: x(10), y(10,10)
    !ERROR: Operands of + are not conformable; have rank 2 and rank 1
    l = y + x
  end
end

! Invalid untyped operands: user-defined operator doesn't affect errors
module m3
  interface operator(+)
    logical function add(x, y)
      logical, intent(in) :: x
      integer, value :: y
    end
  end interface
contains
  subroutine s1(x, y)
    logical :: x
    integer :: y
    integer, pointer :: px
    logical :: l
    complex :: z
    y = y + z'1'  !OK
    !ERROR: Operands of + must be numeric; have untyped and COMPLEX(4)
    z = z'1' + z
    y = +z'1'  !OK
    !ERROR: Operand of unary - must be numeric; have untyped
    y = -z'1'
    !ERROR: Operands of + must be numeric; have LOGICAL(4) and untyped
    y = x + z'1'
    !ERROR: A NULL() pointer is not allowed as an operand here
    l = x /= null()
    !ERROR: A NULL() pointer is not allowed as a relational operand
    l = null(px) /= null(px)
    !ERROR: A NULL() pointer is not allowed as an operand here
    l = x /= null(px)
    !ERROR: A NULL() pointer is not allowed as an operand here
    l = px /= null()
    !ERROR: A NULL() pointer is not allowed as a relational operand
    l = px /= null(px)
    !ERROR: A NULL() pointer is not allowed as an operand here
    l = null() /= null()
  end
end

! Test alternate operators. They aren't enabled by default so should be
! treated as defined operators, not intrinsic ones.
module m4
contains
  subroutine s1(x, y, z)
    logical :: x
    real :: y, z
    !ERROR: No operator .A. defined for REAL(4) and REAL(4)
    x = y .a. z
    !ERROR: No operator .O. defined for REAL(4) and REAL(4)
    x = y .o. z
    !ERROR: No operator .N. defined for REAL(4)
    x = .n. y
    !ERROR: No operator .XOR. defined for REAL(4) and REAL(4)
    x = y .xor. z
    !ERROR: No operator .X. defined for REAL(4)
    x = .x. y
  end
end

! Like m4 in resolve63 but compiled with different options.
! .A. is a defined operator.
module m5
  interface operator(.A.)
    logical function f1(x, y)
      integer, intent(in) :: x, y
    end
  end interface
  interface operator(.and.)
    logical function f2(x, y)
      real, intent(in) :: x, y
    end
  end interface
contains
  subroutine s1(x, y, z)
    logical :: x
    complex :: y, z
    !ERROR: No intrinsic or user-defined OPERATOR(.AND.) matches operand types COMPLEX(4) and COMPLEX(4)
    x = y .and. z
    !ERROR: No intrinsic or user-defined .A. matches operand types COMPLEX(4) and COMPLEX(4)
    x = y .a. z
  end
end

! Type-bound operators
module m6
  type :: t1
  contains
    procedure, pass(x) :: p1 => f1
    generic :: operator(+) => p1
  end type
  type, extends(t1) :: t2
  contains
    procedure, pass(y) :: p2 => f2
    generic :: operator(+) => p2
  end type
  type :: t3
  contains
    procedure, nopass :: p1 => f1
    !ERROR: OPERATOR(+) procedure 'p1' may not have NOPASS attribute
    generic :: operator(+) => p1
  end type
contains
  integer function f1(x, y)
    class(t1), intent(in) :: x
    integer, intent(in) :: y
  end
  integer function f2(x, y)
    class(t1), intent(in) :: x
    class(t2), intent(in) :: y
  end
  subroutine test(x, y, z)
    class(t1) :: x
    class(t2) :: y
    integer :: i
    i = x + y
    i = x + i
    i = y + i
    !ERROR: Operands of + must be numeric; have CLASS(t2) and CLASS(t1)
    i = y + x
    !ERROR: Operands of + must be numeric; have INTEGER(4) and CLASS(t1)
    i = i + x
  end
end

! Some cases where NULL is acceptable - ensure no false errors
module m7
  implicit none
  type :: t1
   contains
    procedure :: s1
    generic :: operator(/) => s1
  end type
  interface operator(-)
    module procedure s2
  end interface
 contains
  integer function s1(x, y)
    class(t1), intent(in) :: x
    class(t1), intent(in), pointer :: y
    s1 = 1
  end
  integer function s2(x, y)
    type(t1), intent(in), pointer :: x, y
    s2 = 2
  end
  subroutine test
    integer :: j
    type(t1), pointer :: x1
    allocate(x1)
    ! These cases are fine.
    j = x1 - x1
    j = x1 - null(mold=x1)
    j = null(mold=x1) - null(mold=x1)
    j = null(mold=x1) - x1
    j = x1 / x1
    j = x1 / null(mold=x1)
    j = null() - null(mold=x1)
    j = null(mold=x1) - null()
    j = null() - null()
    !ERROR: A NULL() pointer is not allowed as an operand here
    j = null() / null(mold=x1)
    !ERROR: A NULL() pointer is not allowed as an operand here
    j = null(mold=x1) / null()
    !ERROR: A NULL() pointer is not allowed as an operand here
    j = null() / null()
  end
end

! 16.9.144(6)
module m8
  interface generic
    procedure s1, s2
  end interface
 contains
  subroutine s1(ip1, rp1)
    integer, pointer, intent(in) :: ip1
    real, pointer, intent(in) :: rp1
  end subroutine
  subroutine s2(rp2, ip2)
    real, pointer, intent(in) :: rp2
    integer, pointer, intent(in) :: ip2
  end subroutine
  subroutine test
    integer, pointer :: ip
    real, pointer :: rp
    call generic(ip, rp) ! ok
    call generic(ip, null()) ! ok
    call generic(rp, null()) ! ok
    call generic(null(), rp) ! ok
    call generic(null(), ip) ! ok
    call generic(null(mold=ip), null()) ! ok
    call generic(null(), null(mold=ip)) ! ok
    !ERROR: The 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
    call generic(null(), null())
  end subroutine
end

module m9
  interface generic
    procedure s1, s2
  end interface
 contains
  subroutine s1(jf)
    procedure(integer) :: jf
  end subroutine
  subroutine s2(af)
    procedure(real) :: af
  end subroutine
  subroutine test
    external underspecified
    !ERROR: The 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
    call generic(underspecified)
  end subroutine
end module

! Ensure no bogus errors for assignments to CLASS(*) allocatable
module m10
  type :: t1
    integer :: n
  end type
 contains
  subroutine test
    class(*), allocatable :: poly
    poly = 1
    poly = 3.14159
    poly = 'Il faut imaginer Sisyphe heureux'
    poly = t1(1)
  end subroutine
end module