! { 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