412f391ca4
When specific procedures of a generic have dummy procedures, underspecified actual procedures can match more than one specific procedure. This can happen with actual procedures that are externals with implicit interfaces, including the completely unspecified case of a PROCEDURE() or EXTERNAL that doesn't even differentiate between a subroutine and a function. Generic resolution can already handle cases of ambiguous resolution due to the use of NULL() actual arguments with no MOLD= arguments to define their types. Extend the handling of ambiguous actual arguments to include the case of underspecified actual procedures. Differential Revision: https://reviews.llvm.org/D140151
380 lines
10 KiB
Fortran
380 lines
10 KiB
Fortran
! 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: 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
|
|
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: 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
|
|
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
|