573fc6187b
The infrastructure in semantics that is used to check that the left-hand sides of normal assignment statements are really definable variables was not being used to check whether the LHSs of pointer assignments are modifiable, and so most cases of unmodifiable pointers are left undiagnosed. Rework the semantics checking for pointer assignments, NULLIFY statements, pointer dummy arguments, &c. so that cases of unmodifiable pointers are properly caught. This has been done by extracting all the various definability checking code that has been implemented for different contexts in Fortran into one new facility. The new consolidated definability checking code returns messages meant to be attached as "because: " explanations to context-dependent errors like "left-hand side of assignment is not definable". These new error message texts and their attached explanations affect many existing tests, which have been updated. The testing infrastructure was extended by another patch to properly compare warnings and explanatory messages, which had been ignored until recently. Differential Revision: https://reviews.llvm.org/D136979
399 lines
16 KiB
Fortran
399 lines
16 KiB
Fortran
! RUN: %python %S/test_errors.py %s %flang_fc1
|
|
! Test 15.5.2.4 constraints and restrictions for non-POINTER non-ALLOCATABLE
|
|
! dummy arguments.
|
|
|
|
module m01
|
|
type :: t
|
|
end type
|
|
type :: pdt(n)
|
|
integer, len :: n
|
|
end type
|
|
type :: pdtWithDefault(n)
|
|
integer, len :: n = 3
|
|
end type
|
|
type :: tbp
|
|
contains
|
|
procedure :: binding => subr01
|
|
end type
|
|
type :: final
|
|
contains
|
|
final :: subr02
|
|
end type
|
|
type :: alloc
|
|
real, allocatable :: a(:)
|
|
end type
|
|
type :: ultimateCoarray
|
|
real, allocatable :: a[:]
|
|
end type
|
|
|
|
contains
|
|
|
|
subroutine subr01(this)
|
|
class(tbp), intent(in) :: this
|
|
end subroutine
|
|
subroutine subr02(this)
|
|
type(final), intent(inout) :: this
|
|
end subroutine
|
|
|
|
subroutine poly(x)
|
|
class(t), intent(in) :: x
|
|
end subroutine
|
|
subroutine polyassumedsize(x)
|
|
class(t), intent(in) :: x(*)
|
|
end subroutine
|
|
subroutine assumedsize(x)
|
|
real :: x(*)
|
|
end subroutine
|
|
subroutine assumedrank(x)
|
|
real :: x(..)
|
|
end subroutine
|
|
subroutine assumedtypeandsize(x)
|
|
type(*) :: x(*)
|
|
end subroutine
|
|
subroutine assumedshape(x)
|
|
real :: x(:)
|
|
end subroutine
|
|
subroutine contiguous(x)
|
|
real, contiguous :: x(:)
|
|
end subroutine
|
|
subroutine intentout(x)
|
|
real, intent(out) :: x
|
|
end subroutine
|
|
subroutine intentout_arr(x)
|
|
real, intent(out) :: x(:)
|
|
end subroutine
|
|
subroutine intentinout(x)
|
|
real, intent(in out) :: x
|
|
end subroutine
|
|
subroutine intentinout_arr(x)
|
|
real, intent(in out) :: x(:)
|
|
end subroutine
|
|
subroutine asynchronous(x)
|
|
real, asynchronous :: x
|
|
end subroutine
|
|
subroutine asynchronous_arr(x)
|
|
real, asynchronous :: x(:)
|
|
end subroutine
|
|
subroutine asynchronousValue(x)
|
|
real, asynchronous, value :: x
|
|
end subroutine
|
|
subroutine volatile(x)
|
|
real, volatile :: x
|
|
end subroutine
|
|
subroutine volatile_arr(x)
|
|
real, volatile :: x(:)
|
|
end subroutine
|
|
subroutine pointer(x)
|
|
real, pointer :: x(:)
|
|
end subroutine
|
|
subroutine valueassumedsize(x)
|
|
real, intent(in) :: x(*)
|
|
end subroutine
|
|
subroutine volatileassumedsize(x)
|
|
real, volatile :: x(*)
|
|
end subroutine
|
|
subroutine volatilecontiguous(x)
|
|
real, volatile :: x(*)
|
|
end subroutine
|
|
|
|
subroutine test01(x) ! 15.5.2.4(2)
|
|
class(t), intent(in) :: x[*]
|
|
!ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument 'x='
|
|
call poly(x[1])
|
|
end subroutine
|
|
|
|
subroutine mono(x)
|
|
type(t), intent(in) :: x(*)
|
|
end subroutine
|
|
subroutine test02(x) ! 15.5.2.4(2)
|
|
class(t), intent(in) :: x(*)
|
|
!ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument 'x='
|
|
call mono(x)
|
|
end subroutine
|
|
|
|
subroutine typestar(x)
|
|
type(*), intent(in) :: x
|
|
end subroutine
|
|
subroutine test03 ! 15.5.2.4(2)
|
|
type(pdt(0)) :: x
|
|
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type
|
|
call typestar(x)
|
|
end subroutine
|
|
|
|
subroutine test04 ! 15.5.2.4(2)
|
|
type(tbp) :: x
|
|
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding'
|
|
call typestar(x)
|
|
end subroutine
|
|
|
|
subroutine test05 ! 15.5.2.4(2)
|
|
type(final) :: x
|
|
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have derived type 'final' with FINAL subroutine 'subr02'
|
|
call typestar(x)
|
|
end subroutine
|
|
|
|
subroutine ch2(x)
|
|
character(2), intent(in) :: x
|
|
end subroutine
|
|
subroutine pdtdefault (derivedArg)
|
|
!ERROR: Type parameter 'n' lacks a value and has no default
|
|
type(pdt) :: derivedArg
|
|
end subroutine pdtdefault
|
|
subroutine pdt3 (derivedArg)
|
|
type(pdt(4)) :: derivedArg
|
|
end subroutine pdt3
|
|
subroutine pdt4 (derivedArg)
|
|
type(pdt(*)) :: derivedArg
|
|
end subroutine pdt4
|
|
subroutine pdtWithDefaultDefault (derivedArg)
|
|
type(pdtWithDefault) :: derivedArg
|
|
end subroutine pdtWithDefaultdefault
|
|
subroutine pdtWithDefault3 (derivedArg)
|
|
type(pdtWithDefault(4)) :: derivedArg
|
|
end subroutine pdtWithDefault3
|
|
subroutine pdtWithDefault4 (derivedArg)
|
|
type(pdtWithDefault(*)) :: derivedArg
|
|
end subroutine pdtWithDefault4
|
|
subroutine test06 ! 15.5.2.4(4)
|
|
!ERROR: Type parameter 'n' lacks a value and has no default
|
|
type(pdt) :: vardefault
|
|
type(pdt(3)) :: var3
|
|
type(pdt(4)) :: var4
|
|
type(pdtWithDefault) :: defaultVardefault
|
|
type(pdtWithDefault(3)) :: defaultVar3
|
|
type(pdtWithDefault(4)) :: defaultVar4
|
|
character :: ch1
|
|
!ERROR: Actual argument variable length '1' is less than expected length '2'
|
|
call ch2(ch1)
|
|
!WARNING: Actual argument expression length '0' is less than expected length '2'
|
|
call ch2("")
|
|
call pdtdefault(vardefault)
|
|
call pdtdefault(var3)
|
|
call pdtdefault(var4) ! error
|
|
call pdt3(vardefault) ! error
|
|
!ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)'
|
|
call pdt3(var3) ! error
|
|
call pdt3(var4)
|
|
call pdt4(vardefault)
|
|
call pdt4(var3)
|
|
call pdt4(var4)
|
|
call pdtWithDefaultdefault(defaultVardefault)
|
|
call pdtWithDefaultdefault(defaultVar3)
|
|
!ERROR: Actual argument type 'pdtwithdefault(n=4_4)' is not compatible with dummy argument type 'pdtwithdefault(n=3_4)'
|
|
call pdtWithDefaultdefault(defaultVar4) ! error
|
|
!ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
|
|
call pdtWithDefault3(defaultVardefault) ! error
|
|
!ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
|
|
call pdtWithDefault3(defaultVar3) ! error
|
|
call pdtWithDefault3(defaultVar4)
|
|
call pdtWithDefault4(defaultVardefault)
|
|
call pdtWithDefault4(defaultVar3)
|
|
call pdtWithDefault4(defaultVar4)
|
|
end subroutine
|
|
|
|
subroutine out01(x)
|
|
type(alloc) :: x
|
|
end subroutine
|
|
subroutine test07(x) ! 15.5.2.4(6)
|
|
type(alloc) :: x[*]
|
|
!ERROR: Coindexed actual argument with ALLOCATABLE ultimate component '%a' must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
|
|
call out01(x[1])
|
|
end subroutine
|
|
|
|
subroutine test08(x) ! 15.5.2.4(13)
|
|
real :: x(1)[*]
|
|
!ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x='
|
|
call assumedsize(x(1)[1])
|
|
end subroutine
|
|
|
|
subroutine charray(x)
|
|
character :: x(10)
|
|
end subroutine
|
|
subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11
|
|
real :: x, arr(10)
|
|
real, pointer :: p(:)
|
|
real, pointer :: p_scalar
|
|
character(10), pointer :: char_pointer(:)
|
|
character(*) :: assumed_shape_char(:)
|
|
real :: ashape(:)
|
|
class(t) :: polyarray(*)
|
|
character(10) :: c(:)
|
|
!ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
|
|
call assumedsize(x)
|
|
!ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
|
|
call assumedsize(p_scalar)
|
|
!ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
|
|
call assumedsize(p(1))
|
|
!ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
|
|
call assumedsize(ashape(1))
|
|
!ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array
|
|
call polyassumedsize(polyarray(1))
|
|
call charray(c(1:1)) ! not an error if character
|
|
call charray(char_pointer(1)) ! not an error if character
|
|
call charray(assumed_shape_char(1)) ! not an error if character
|
|
call assumedsize(arr(1)) ! not an error if element in sequence
|
|
call assumedrank(x) ! not an error
|
|
call assumedtypeandsize(x) ! not an error
|
|
end subroutine
|
|
|
|
subroutine test10(a) ! 15.5.2.4(16)
|
|
real :: scalar, matrix(2,3)
|
|
real :: a(*)
|
|
!ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
|
|
call assumedshape(scalar)
|
|
call assumedshape(reshape(matrix,shape=[size(matrix)])) ! ok
|
|
!ERROR: Rank of dummy argument is 1, but actual argument has rank 2
|
|
call assumedshape(matrix)
|
|
!ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
|
|
call assumedshape(a)
|
|
end subroutine
|
|
|
|
subroutine test11(in) ! C15.5.2.4(20)
|
|
real, intent(in) :: in
|
|
real :: x
|
|
x = 0.
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: 'in' is an INTENT(IN) dummy argument
|
|
call intentout(in)
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: '3.141590118408203125_4' is not a variable or pointer
|
|
call intentout(3.14159)
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: 'in+1._4' is not a variable or pointer
|
|
call intentout(in + 1.)
|
|
call intentout(x) ! ok
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: '(x)' is not a variable or pointer
|
|
call intentout((x))
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' is not definable
|
|
!BECAUSE: '2_4' is not a variable or pointer
|
|
call system_clock(count=2)
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: 'in' is an INTENT(IN) dummy argument
|
|
call intentinout(in)
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: '3.141590118408203125_4' is not a variable or pointer
|
|
call intentinout(3.14159)
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: 'in+1._4' is not a variable or pointer
|
|
call intentinout(in + 1.)
|
|
call intentinout(x) ! ok
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: '(x)' is not a variable or pointer
|
|
call intentinout((x))
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' is not definable
|
|
!BECAUSE: '0_4' is not a variable or pointer
|
|
call execute_command_line(command="echo hello", exitstat=0)
|
|
end subroutine
|
|
|
|
subroutine test12 ! 15.5.2.4(21)
|
|
real :: a(1)
|
|
integer :: j(1)
|
|
j(1) = 1
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
|
|
call intentout_arr(a(j))
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
|
|
!BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
|
|
call intentinout_arr(a(j))
|
|
call asynchronous_arr(a(j)) ! ok
|
|
call volatile_arr(a(j)) ! ok
|
|
end subroutine
|
|
|
|
subroutine coarr(x)
|
|
type(ultimateCoarray):: x
|
|
end subroutine
|
|
subroutine volcoarr(x)
|
|
type(ultimateCoarray), volatile :: x
|
|
end subroutine
|
|
subroutine test13(a, b) ! 15.5.2.4(22)
|
|
type(ultimateCoarray) :: a
|
|
type(ultimateCoarray), volatile :: b
|
|
call coarr(a) ! ok
|
|
call volcoarr(b) ! ok
|
|
!ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
|
|
call coarr(b)
|
|
!ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
|
|
call volcoarr(a)
|
|
end subroutine
|
|
|
|
subroutine test14(a,b,c,d) ! C1538
|
|
real :: a[*]
|
|
real, asynchronous :: b[*]
|
|
real, volatile :: c[*]
|
|
real, asynchronous, volatile :: d[*]
|
|
call asynchronous(a[1]) ! ok
|
|
call volatile(a[1]) ! ok
|
|
call asynchronousValue(b[1]) ! ok
|
|
call asynchronousValue(c[1]) ! ok
|
|
call asynchronousValue(d[1]) ! ok
|
|
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
|
|
call asynchronous(b[1])
|
|
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
|
|
call volatile(b[1])
|
|
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
|
|
call asynchronous(c[1])
|
|
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
|
|
call volatile(c[1])
|
|
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
|
|
call asynchronous(d[1])
|
|
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
|
|
call volatile(d[1])
|
|
end subroutine
|
|
|
|
subroutine test15() ! C1539
|
|
real, pointer :: a(:)
|
|
real, asynchronous :: b(10)
|
|
real, volatile :: c(10)
|
|
real, asynchronous, volatile :: d(10)
|
|
call assumedsize(a(::2)) ! ok
|
|
call contiguous(a(::2)) ! ok
|
|
call valueassumedsize(a(::2)) ! ok
|
|
call valueassumedsize(b(::2)) ! ok
|
|
call valueassumedsize(c(::2)) ! ok
|
|
call valueassumedsize(d(::2)) ! ok
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatileassumedsize(b(::2))
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatilecontiguous(b(::2))
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatileassumedsize(c(::2))
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatilecontiguous(c(::2))
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatileassumedsize(d(::2))
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatilecontiguous(d(::2))
|
|
end subroutine
|
|
|
|
subroutine test16() ! C1540
|
|
real, pointer :: a(:)
|
|
real, asynchronous, pointer :: b(:)
|
|
real, volatile, pointer :: c(:)
|
|
real, asynchronous, volatile, pointer :: d(:)
|
|
call assumedsize(a) ! ok
|
|
call contiguous(a) ! ok
|
|
call pointer(a) ! ok
|
|
call pointer(b) ! ok
|
|
call pointer(c) ! ok
|
|
call pointer(d) ! ok
|
|
call valueassumedsize(a) ! ok
|
|
call valueassumedsize(b) ! ok
|
|
call valueassumedsize(c) ! ok
|
|
call valueassumedsize(d) ! ok
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatileassumedsize(b)
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatilecontiguous(b)
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatileassumedsize(c)
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatilecontiguous(c)
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatileassumedsize(d)
|
|
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
|
|
call volatilecontiguous(d)
|
|
end subroutine
|
|
|
|
end module
|