forked from OSchip/llvm-project
313 lines
12 KiB
Fortran
313 lines
12 KiB
Fortran
! RUN: %S/test_errors.sh %s %t %f18
|
|
! 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 :: 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)
|
|
class(final), intent(in) :: 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 intentinout(x)
|
|
real, intent(in out) :: x
|
|
end subroutine
|
|
subroutine asynchronous(x)
|
|
real, asynchronous :: x
|
|
end subroutine
|
|
subroutine asynchronousValue(x)
|
|
real, asynchronous, value :: x
|
|
end subroutine
|
|
subroutine volatile(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 FINAL subroutine 'subr02'
|
|
call typestar(x)
|
|
end subroutine
|
|
|
|
subroutine ch2(x)
|
|
character(2), intent(in out) :: x
|
|
end subroutine
|
|
subroutine test06 ! 15.5.2.4(4)
|
|
character :: ch1
|
|
! The actual argument is converted to a padded expression.
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
|
|
call ch2(ch1)
|
|
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) ! 15.5.2.4(14), 15.5.2.11
|
|
real :: x, arr(10)
|
|
real, pointer :: p(:)
|
|
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: Scalar POINTER target 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 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)
|
|
!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=' must be definable
|
|
call intentout(in)
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
|
|
call intentout(3.14159)
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
|
|
call intentout(in + 1.)
|
|
call intentout(x) ! ok
|
|
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
|
|
call intentout((x))
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
|
|
call intentinout(in)
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
|
|
call intentinout(3.14159)
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
|
|
call intentinout(in + 1.)
|
|
call intentinout(x) ! ok
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
|
|
call intentinout((x))
|
|
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=' must be definable
|
|
call intentout(a(j))
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
|
|
call intentinout(a(j))
|
|
!ERROR: Actual argument associated with ASYNCHRONOUS dummy argument 'x=' must be definable
|
|
call asynchronous(a(j))
|
|
!ERROR: Actual argument associated with VOLATILE dummy argument 'x=' must be definable
|
|
call volatile(a(j))
|
|
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
|