3d1157000d
A recent patch to allow pFUnit to compile softened the diagnostic about indistinguishable specific procedures to a portability warning. It turns out that this was overkill -- for specific procedures containing no optional or unlimited polymorphic dummy data arguments, a diagnosis of "indistinguishable" can still be a hard error. So adjust the analysis to be tri-state: two procedures are either definitely distinguishable, definitely indistinguishable without optionals or unlimited polymorphics, or indeterminate. Emit errors as before for the definitely indistinguishable cases; continue to emit portability warnings for the indeterminate cases. When this patch is merged, all but one of the dozen or so tests that I disabled in llvm-test-suite can be re-enabled.
142 lines
4.7 KiB
Fortran
142 lines
4.7 KiB
Fortran
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
|
|
! Test restrictions on what subprograms can be used for defined assignment.
|
|
|
|
module m1
|
|
implicit none
|
|
type :: t
|
|
contains
|
|
!ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t4' and 't%assign_t5' as their interfaces are not distinguishable
|
|
!ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t4' and 't%assign_t6' as their interfaces are not distinguishable
|
|
!ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t5' and 't%assign_t6' as their interfaces are not distinguishable
|
|
!ERROR: Defined assignment procedure 'binding' must be a subroutine
|
|
generic :: assignment(=) => binding
|
|
procedure :: binding => assign_t1
|
|
procedure :: assign_t
|
|
procedure :: assign_t2
|
|
procedure :: assign_t3
|
|
!ERROR: Defined assignment subroutine 'assign_t2' must have two dummy arguments
|
|
!WARNING: In defined assignment subroutine 'assign_t3', second dummy argument 'y' should have INTENT(IN) or VALUE attribute
|
|
!WARNING: In defined assignment subroutine 'assign_t4', first dummy argument 'x' should have INTENT(OUT) or INTENT(INOUT)
|
|
!ERROR: In defined assignment subroutine 'assign_t5', first dummy argument 'x' may not have INTENT(IN)
|
|
!ERROR: In defined assignment subroutine 'assign_t6', second dummy argument 'y' may not have INTENT(OUT)
|
|
generic :: assignment(=) => assign_t, assign_t2, assign_t3, assign_t4, assign_t5, assign_t6
|
|
procedure :: assign_t4
|
|
procedure :: assign_t5
|
|
procedure :: assign_t6
|
|
end type
|
|
type :: t2
|
|
contains
|
|
procedure, nopass :: assign_t
|
|
!ERROR: Defined assignment procedure 'assign_t' may not have NOPASS attribute
|
|
generic :: assignment(=) => assign_t
|
|
end type
|
|
contains
|
|
subroutine assign_t(x, y)
|
|
class(t), intent(out) :: x
|
|
type(t), intent(in) :: y
|
|
end
|
|
logical function assign_t1(x, y)
|
|
class(t), intent(out) :: x
|
|
type(t), intent(in) :: y
|
|
end
|
|
subroutine assign_t2(x)
|
|
class(t), intent(out) :: x
|
|
end
|
|
subroutine assign_t3(x, y)
|
|
class(t), intent(out) :: x
|
|
real :: y
|
|
end
|
|
subroutine assign_t4(x, y)
|
|
class(t) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
subroutine assign_t5(x, y)
|
|
class(t), intent(in) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
subroutine assign_t6(x, y)
|
|
class(t), intent(out) :: x
|
|
integer, intent(out) :: y
|
|
end
|
|
end
|
|
|
|
module m2
|
|
type :: t
|
|
end type
|
|
!ERROR: Generic 'assignment(=)' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
|
|
interface assignment(=)
|
|
!ERROR: In defined assignment subroutine 's1', dummy argument 'y' may not be OPTIONAL
|
|
subroutine s1(x, y)
|
|
import t
|
|
type(t), intent(out) :: x
|
|
real, optional, intent(in) :: y
|
|
end
|
|
!ERROR: In defined assignment subroutine 's2', dummy argument 'y' must be a data object
|
|
subroutine s2(x, y)
|
|
import t
|
|
type(t), intent(out) :: x
|
|
intent(in) :: y
|
|
interface
|
|
subroutine y()
|
|
end
|
|
end interface
|
|
end
|
|
!ERROR: In defined assignment subroutine 's3', second dummy argument 'y' must not be a pointer
|
|
subroutine s3(x, y)
|
|
import t
|
|
type(t), intent(out) :: x
|
|
type(t), intent(in), pointer :: y
|
|
end
|
|
!ERROR: In defined assignment subroutine 's4', second dummy argument 'y' must not be an allocatable
|
|
subroutine s4(x, y)
|
|
import t
|
|
type(t), intent(out) :: x
|
|
type(t), intent(in), allocatable :: y
|
|
end
|
|
end interface
|
|
end
|
|
|
|
! Detect defined assignment that conflicts with intrinsic assignment
|
|
module m5
|
|
type :: t
|
|
end type
|
|
interface assignment(=)
|
|
! OK - lhs is derived type
|
|
subroutine assign_tt(x, y)
|
|
import t
|
|
type(t), intent(out) :: x
|
|
type(t), intent(in) :: y
|
|
end
|
|
!OK - incompatible types
|
|
subroutine assign_il(x, y)
|
|
integer, intent(out) :: x
|
|
logical, intent(in) :: y
|
|
end
|
|
!OK - different ranks
|
|
subroutine assign_23(x, y)
|
|
integer, intent(out) :: x(:,:)
|
|
integer, intent(in) :: y(:,:,:)
|
|
end
|
|
!OK - scalar = array
|
|
subroutine assign_01(x, y)
|
|
integer, intent(out) :: x
|
|
integer, intent(in) :: y(:)
|
|
end
|
|
!ERROR: Defined assignment subroutine 'assign_10' conflicts with intrinsic assignment
|
|
subroutine assign_10(x, y)
|
|
integer, intent(out) :: x(:)
|
|
integer, intent(in) :: y
|
|
end
|
|
!ERROR: Defined assignment subroutine 'assign_ir' conflicts with intrinsic assignment
|
|
subroutine assign_ir(x, y)
|
|
integer, intent(out) :: x
|
|
real, intent(in) :: y
|
|
end
|
|
!ERROR: Defined assignment subroutine 'assign_ii' conflicts with intrinsic assignment
|
|
subroutine assign_ii(x, y)
|
|
integer(2), intent(out) :: x
|
|
integer(1), intent(in) :: y
|
|
end
|
|
end interface
|
|
end
|