176 lines
4.3 KiB
Fortran
176 lines
4.3 KiB
Fortran
! { dg-do compile }
|
|
! { dg-options "-fmax-errors=1000 -fcoarray=single" }
|
|
!
|
|
! PR fortran/18918
|
|
!
|
|
! Coarray expressions.
|
|
!
|
|
program test
|
|
implicit none
|
|
type t3
|
|
integer, allocatable :: a
|
|
end type t3
|
|
type t4
|
|
type(t3) :: xt3
|
|
end type t4
|
|
type t
|
|
integer, pointer :: ptr
|
|
integer, allocatable :: alloc(:)
|
|
end type t
|
|
type(t), target :: i[*]
|
|
type(t), allocatable :: ca[:]
|
|
type(t4), target :: tt4[*]
|
|
type(t4), allocatable :: ca2[:]
|
|
integer, volatile :: volat[*]
|
|
integer, asynchronous :: async[*]
|
|
integer :: caf1[1,*], caf2[*]
|
|
allocate(i%ptr)
|
|
call foo(i%ptr)
|
|
call foo(i[1]%ptr) ! { dg-error "Coindexed actual argument at .1. to pointer dummy" }
|
|
call bar(i%ptr)
|
|
call bar(i[1]%ptr) ! OK, value of ptr target
|
|
call bar(i[1]%alloc(1)) ! OK
|
|
call typeDummy(i) ! OK
|
|
call typeDummy(i[1]) ! { dg-error "with ultimate pointer component" }
|
|
call typeDummy2(ca) ! OK
|
|
call typeDummy2(ca[1]) ! { dg-error "with ultimate pointer component" }
|
|
call typeDummy3(tt4%xt3) ! OK
|
|
call typeDummy3(tt4[1]%xt3) ! { dg-error "requires either VALUE or INTENT.IN." }
|
|
call typeDummy4(ca2) ! OK
|
|
call typeDummy4(ca2[1]) ! { dg-error "requires INTENT.IN." }
|
|
! Note: Checking an VOLATILE dummy is not possible as volatile + intent(in)
|
|
! is not possible
|
|
|
|
call asyn(volat)
|
|
call asyn(async)
|
|
call asyn(volat[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
|
|
call asyn(async[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
|
|
|
|
call coarray(caf1) ! rank mismatch; OK, for non allocatable coarrays
|
|
call coarray(caf2)
|
|
call coarray(caf2[1]) ! { dg-error "must be a coarray" }
|
|
call ups(i)
|
|
call ups(i[1]) ! { dg-error "with ultimate pointer component" }
|
|
call ups(i%ptr)
|
|
call ups(i[1]%ptr) ! OK - passes target not pointer
|
|
contains
|
|
subroutine asyn(a)
|
|
integer, intent(in), asynchronous :: a
|
|
end subroutine asyn
|
|
subroutine bar(a)
|
|
integer :: a
|
|
end subroutine bar
|
|
subroutine foo(a)
|
|
integer, pointer :: a
|
|
end subroutine foo
|
|
subroutine coarray(a)
|
|
integer :: a[*]
|
|
end subroutine coarray
|
|
subroutine typeDummy(a)
|
|
type(t) :: a
|
|
end subroutine typeDummy
|
|
subroutine typeDummy2(a)
|
|
type(t),allocatable :: a
|
|
end subroutine typeDummy2
|
|
subroutine typeDummy3(a)
|
|
type(t3) :: a
|
|
end subroutine typeDummy3
|
|
subroutine typeDummy4(a)
|
|
type(t4), allocatable :: a
|
|
end subroutine typeDummy4
|
|
end program test
|
|
|
|
|
|
subroutine alloc()
|
|
type t
|
|
integer, allocatable :: a(:)
|
|
end type t
|
|
type(t), save :: a[*]
|
|
type(t), allocatable :: b(:)[:], C[:]
|
|
|
|
allocate(b(1)) ! { dg-error "Coarray specification" }
|
|
allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
|
|
allocate(c[*]) ! { dg-error "Sorry" }
|
|
allocate(a%a(5)) ! OK
|
|
end subroutine alloc
|
|
|
|
|
|
subroutine dataPtr()
|
|
integer, save, target :: a[*]
|
|
data a/5/ ! OK
|
|
data a[1]/5/ ! { dg-error "cannot have a coindex" }
|
|
type t
|
|
integer, pointer :: p
|
|
end type t
|
|
type(t), save :: x[*]
|
|
|
|
type t2
|
|
integer :: a(1)
|
|
end type t2
|
|
type(t2) y
|
|
data y%a/4/
|
|
|
|
|
|
x[1]%p => a ! { dg-error "shall not have a coindex" }
|
|
x%p => a[1] ! { dg-error "shall not have a coindex" }
|
|
end subroutine dataPtr
|
|
|
|
|
|
subroutine test3()
|
|
implicit none
|
|
type t
|
|
integer :: a(1)
|
|
end type t
|
|
type(t), save :: x[*]
|
|
data x%a/4/
|
|
|
|
integer, save :: y(1)[*] !(1)
|
|
call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" }
|
|
contains
|
|
subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" }
|
|
integer :: a(:)[:]
|
|
end subroutine sub
|
|
end subroutine test3
|
|
|
|
|
|
subroutine test4()
|
|
integer, save :: i[*]
|
|
integer :: j
|
|
call foo(i)
|
|
call foo(j) ! { dg-error "must be a coarray" }
|
|
contains
|
|
subroutine foo(a)
|
|
integer :: a[*]
|
|
end subroutine foo
|
|
end subroutine test4
|
|
|
|
|
|
subroutine allocateTest()
|
|
implicit none
|
|
real, allocatable, codimension[:,:] :: a,b,c
|
|
integer :: n, q
|
|
n = 1
|
|
q = 1
|
|
allocate(a[q,*]) ! { dg-error "Sorry" }
|
|
allocate(b[q,*]) ! { dg-error "Sorry" }
|
|
allocate(c[q,*]) ! { dg-error "Sorry" }
|
|
end subroutine allocateTest
|
|
|
|
|
|
subroutine testAlloc4()
|
|
implicit none
|
|
type co_double_3
|
|
double precision, allocatable :: array(:)
|
|
end type co_double_3
|
|
type(co_double_3),save, codimension[*] :: work
|
|
allocate(work%array(1))
|
|
print *, size(work%array)
|
|
end subroutine testAlloc4
|
|
|
|
subroutine test5()
|
|
implicit none
|
|
integer, save :: i[*]
|
|
print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" }
|
|
end subroutine test5
|
|
|