1! { dg-do compile } 2! { dg-options "-fmax-errors=1000 -fcoarray=single" } 3! 4! PR fortran/18918 5! 6! Coarray expressions. 7! 8program test 9 implicit none 10 type t3 11 integer, allocatable :: a 12 end type t3 13 type t4 14 type(t3) :: xt3 15 end type t4 16 type t 17 integer, pointer :: ptr 18 integer, allocatable :: alloc(:) 19 end type t 20 type(t), target :: i[*] 21 type(t), allocatable :: ca[:] 22 type(t4), target :: tt4[*] 23 type(t4), allocatable :: ca2[:] 24 integer, volatile :: volat[*] 25 integer, asynchronous :: async[*] 26 integer :: caf1[1,*], caf2[*] 27 allocate(i%ptr) 28 call foo(i%ptr) 29 call foo(i[1]%ptr) ! { dg-error "Coindexed actual argument at .1. to pointer dummy" } 30 call bar(i%ptr) 31 call bar(i[1]%ptr) ! OK, value of ptr target 32 call bar(i[1]%alloc(1)) ! OK 33 call typeDummy(i) ! OK 34 call typeDummy(i[1]) ! { dg-error "with ultimate pointer component" } 35 call typeDummy2(ca) ! OK 36 call typeDummy2(ca[1]) ! { dg-error "with ultimate pointer component" } 37 call typeDummy3(tt4%xt3) ! OK 38 call typeDummy3(tt4[1]%xt3) ! { dg-error "requires either VALUE or INTENT.IN." } 39 call typeDummy4(ca2) ! OK 40 call typeDummy4(ca2[1]) ! { dg-error "requires INTENT.IN." } 41! Note: Checking an VOLATILE dummy is not possible as volatile + intent(in) 42! is not possible 43 44 call asyn(volat) 45 call asyn(async) 46 call asyn(volat[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" } 47 call asyn(async[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" } 48 49 call coarray(caf1) ! rank mismatch; OK, for non allocatable coarrays 50 call coarray(caf2) 51 call coarray(caf2[1]) ! { dg-error "must be a coarray" } 52 call ups(i) 53 call ups(i[1]) ! { dg-error "with ultimate pointer component" } 54 call ups(i%ptr) 55 call ups(i[1]%ptr) ! OK - passes target not pointer 56contains 57 subroutine asyn(a) 58 integer, intent(in), asynchronous :: a 59 end subroutine asyn 60 subroutine bar(a) 61 integer :: a 62 end subroutine bar 63 subroutine foo(a) 64 integer, pointer :: a 65 end subroutine foo 66 subroutine coarray(a) 67 integer :: a[*] 68 end subroutine coarray 69 subroutine typeDummy(a) 70 type(t) :: a 71 end subroutine typeDummy 72 subroutine typeDummy2(a) 73 type(t),allocatable :: a 74 end subroutine typeDummy2 75 subroutine typeDummy3(a) 76 type(t3) :: a 77 end subroutine typeDummy3 78 subroutine typeDummy4(a) 79 type(t4), allocatable :: a 80 end subroutine typeDummy4 81end program test 82 83 84subroutine alloc() 85type t 86 integer, allocatable :: a(:) 87end type t 88type(t), save :: a[*] 89type(t), allocatable :: b(:)[:], C[:] 90 91allocate(b(1)) ! { dg-error "Coarray specification" } 92allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" } 93allocate(c[*]) ! OK 94allocate(a%a(5)) ! OK 95end subroutine alloc 96 97 98subroutine dataPtr() 99 integer, save, target :: a[*] 100 data a/5/ ! OK 101 data a[1]/5/ ! { dg-error "cannot have a coindex" } 102 type t 103 integer, pointer :: p 104 end type t 105 type(t), save :: x[*] 106 107 type t2 108 integer :: a(1) 109 end type t2 110 type(t2) y 111 data y%a/4/ 112 113 114 x[1]%p => a ! { dg-error "shall not have a coindex" } 115 x%p => a[1] ! { dg-error "shall not have a coindex" } 116end subroutine dataPtr 117 118 119subroutine test3() 120implicit none 121type t 122 integer :: a(1) 123end type t 124type(t), save :: x[*] 125data x%a/4/ 126 127 integer, save :: y(1)[*] !(1) 128 call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" } 129contains 130 subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" } 131 integer :: a(:)[:] 132 end subroutine sub 133end subroutine test3 134 135 136subroutine test4() 137 integer, save :: i[*] 138 integer :: j 139 call foo(i) 140 call foo(j) ! { dg-error "must be a coarray" } 141contains 142 subroutine foo(a) 143 integer :: a[*] 144 end subroutine foo 145end subroutine test4 146 147 148subroutine allocateTest() 149 implicit none 150 real, allocatable, codimension[:,:] :: a,b,c 151 integer :: n, q 152 n = 1 153 q = 1 154 allocate(a[q,*]) ! OK 155 allocate(b[q,*]) ! OK 156 allocate(c[q,*]) ! OK 157end subroutine allocateTest 158 159 160subroutine testAlloc4() 161 implicit none 162 type co_double_3 163 double precision, allocatable :: array(:) 164 end type co_double_3 165 type(co_double_3),save, codimension[*] :: work 166 allocate(work%array(1)) 167 print *, size(work%array) 168end subroutine testAlloc4 169 170subroutine test5() 171 implicit none 172 integer, save :: i[*] 173 print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" } 174end subroutine test5 175 176