mirror of
https://github.com/llvm/llvm-project.git
synced 2025-04-17 03:46:46 +00:00

When a generic procedure interface, either declared or the result of merging two use-associated generics, has two specific procedures that are not distinguishable according to the rules in F'2023 subclause 15.4.3.4.5, emit a portability warning rather than a hard error message. The rules in that subclause are not adequate to detect pairs of specific procedures that admit an ambiguous reference, as demonstrated by a case that arose in pFUnit. Further, these distinguishability checks, even if sufficient to the task of detecting pairs of specifics capable of ambiguous references, should only apply to pairs where *every* reference would have to be ambiguous -- and this can and is validated at every reference anyway. Last, only XLF enforces these incomplete and needless distinguishability rules -- every other compiler seems to just check that each procedure reference resolves to exactly one specific procedure. If the standard were to complete lose subclause 15.4.3.4.5 and its related note (C.11.6) -- which admits that the rules are incomplete! -- and simply require that each generic procedure reference resolve unambiguously to exactly one specific, nobody would miss them. This patch changes this compiler to give them lip service when requested, but they are now otherwise ignored.
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: 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
|