1! { dg-do compile }
2! { dg-options "-fmax-errors=1000 -fcoarray=single" }
3!
4! PR fortran/18918
5!
6! Coarray expressions.
7!
8module mod2
9  implicit none
10  type t
11    procedure(sub), pointer :: ppc
12  contains
13    procedure :: tbp => sub
14  end type t
15  type t2
16    class(t), allocatable :: poly
17  end type t2
18contains
19  subroutine sub(this)
20    class(t), intent(in) :: this
21  end subroutine sub
22end module mod2
23
24subroutine procTest(y,z)
25  use mod2
26  implicit none
27  type(t), save :: x[*]
28  type(t) :: y[*]
29  type(t2) :: z[*]
30
31  x%ppc => sub
32  call x%ppc() ! OK
33  call x%tbp() ! OK
34  call x[1]%tbp ! OK, not polymorphic
35  ! Invalid per C726
36  call x[1]%ppc ! { dg-error "Coindexed procedure-pointer component" }
37
38  y%ppc => sub
39  call y%ppc() ! OK
40  call y%tbp() ! OK
41  call y[1]%tbp ! OK, coindexed polymorphic object but not poly. subobj.
42  call y[1]%ppc ! { dg-error "Coindexed procedure-pointer component" }
43
44  ! Invalid per C1229
45  z%poly%ppc => sub
46  call z%poly%ppc() ! OK
47  call z%poly%tbp() ! OK
48  call z[1]%poly%tbp ! { dg-error "Polymorphic subobject of coindexed" }
49  call z[1]%poly%ppc ! { dg-error "Coindexed procedure-pointer component" }
50end subroutine procTest
51
52
53module m
54  type t1
55    integer, pointer :: p
56  end type t1
57  type t2
58    integer :: i
59  end type t2
60  type t
61    integer, allocatable :: a[:]
62    type(t1), allocatable :: b[:]
63    type(t2), allocatable :: c[:]
64  end type t
65contains
66  pure subroutine p2(x)
67   integer, intent(inout) :: x
68  end subroutine p2
69  pure subroutine p3(x)
70   integer, pointer :: x
71  end subroutine p3
72  pure subroutine p1(x)
73    type(t), intent(inout) :: x
74    integer, target :: tgt1
75    x%a = 5
76    x%a[6] = 9 ! { dg-error "Assignment to coindexed variable" }
77    x%b%p => tgt1
78    x%b[1]%p => tgt1 ! { dg-error "shall not have a coindex" }
79    x%b%p => x%b[1]%p ! { dg-error "shall not have a coindex" }
80    x%b = t1(x%b[1]%p) ! { dg-error "Coindexed expression to pointer component" }
81    x%b = x%b[1] ! { dg-error "derived type variable with a POINTER component in a PURE" }
82    call p2 (x%c[1]%i) ! { dg-error "Coindexed actual argument" }
83    call p3 (x%b[1]%p) ! { dg-error "to pointer dummy" }
84  end subroutine p1
85  subroutine nonPtr()
86    type(t1), save :: a[*]
87    type(t2), save :: b[*]
88    integer, target :: tgt1
89    a%p => tgt1
90    a[1]%p => tgt1 ! { dg-error "shall not have a coindex" }
91    a%p => a[2]%p ! { dg-error "shall not have a coindex" }
92    a = t1(a[1]%p) ! { dg-error "Coindexed expression to pointer component" }
93    call p2 (b[1]%i) ! OK
94    call p2 (a[1]%p) ! OK - pointer target and not pointer
95  end subroutine nonPtr
96end module m
97
98
99module mmm3
100 type t
101   integer, allocatable :: a(:)
102 end type t
103contains
104  subroutine assign(x)
105    type(t) :: x[*]
106    allocate(x%a(3))
107    x%a = [ 1, 2, 3]
108    x[1]%a = [ 1, 2, 3] ! OK - if shapes are the same, otherwise wrong
109                        ! (no reallocate on assignment)
110  end subroutine assign
111  subroutine assign2(x,y)
112    type(t),allocatable :: x[:]
113    type(t) :: y
114    x = y
115    x[1] = y ! { dg-error "must not have an allocatable ultimate component" }
116  end subroutine assign2
117end module mmm3
118
119
120module mmm4
121  implicit none
122contains
123  subroutine t1(x)
124    integer :: x(1)
125  end subroutine t1
126  subroutine t3(x)
127    character :: x(*)
128  end subroutine t3
129  subroutine t2()
130    integer, save :: x[*]
131    integer, save :: y(1)[*]
132    character(len=20), save :: z[*]
133
134    call t1(x) ! { dg-error "Rank mismatch" }
135    call t1(x[1]) ! { dg-error "Rank mismatch" }
136
137    call t1(y(1)) ! OK
138    call t1(y(1)[1]) ! { dg-error "Rank mismatch" }
139
140    call t3(z) !  OK
141    call t3(z[1]) ! { dg-error "Rank mismatch" }
142  end subroutine t2
143end module mmm4
144
145
146subroutine tfgh()
147  integer :: i(2)
148  DATA i/(i, i=1,2)/ ! { dg-error "Expected PARAMETER symbol" }
149  do i = 1, 5 ! { dg-error "cannot be a sub-component" }
150  end do ! { dg-error "Expecting END SUBROUTINE" }
151end subroutine tfgh
152
153subroutine tfgh2()
154  integer, save :: x[*]
155  integer :: i(2)
156  DATA i/(x, x=1,2)/ ! { dg-error "Expected PARAMETER symbol" }
157  do x = 1, 5 ! { dg-error "cannot be a coarray" }
158  end do ! { dg-error "Expecting END SUBROUTINE" }
159end subroutine tfgh2
160
161
162subroutine f4f4()
163  type t
164    procedure(), pointer, nopass :: ppt => null()
165  end type t
166  external foo
167  type(t), save :: x[*]
168  x%ppt => foo
169  x[1]%ppt => foo ! { dg-error "shall not have a coindex" }
170end subroutine f4f4
171
172
173subroutine corank()
174  integer, allocatable :: a[:,:]
175  call one(a) ! OK
176  call two(a) !  { dg-error "Corank mismatch in argument" }
177contains
178  subroutine one(x)
179    integer :: x[*]
180  end subroutine one
181  subroutine two(x)
182    integer, allocatable :: x[:]
183  end subroutine two
184end subroutine corank
185
186subroutine assign42()
187  integer, allocatable :: z(:)[:]
188  z(:)[1] = z
189end subroutine assign42
190