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