llvm-project/flang/test/Semantics/call03.f90

368 lines
14 KiB
Fortran

! RUN: %S/test_errors.sh %s %t %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 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 derived type 'final' with FINAL subroutine 'subr02'
call typestar(x)
end subroutine
subroutine ch2(x)
character(2), intent(in out) :: 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
! 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)
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) ! 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(OUT) dummy argument 'count=' must be definable
call system_clock(count=2)
!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))
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' must be definable
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=' 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