OSDN Git Service

8cd295d38b3c68b8a23bf54a55224883dd6fe666
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / coarray_7.f90
1 ! { dg-do compile }
2 ! { dg-options "-fmax-errors=1000 -fcoarray=single" }
3 !
4 ! PR fortran/18918
5 !
6 ! Coarray expressions.
7 !
8 program 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
56 contains
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
81 end program test
82
83
84 subroutine alloc()
85 type t
86   integer, allocatable :: a(:)
87 end type t
88 type(t), save :: a[*]
89 type(t), allocatable :: b(:)[:], C[:]
90
91 allocate(b(1)) ! { dg-error "Coarray specification" }
92 allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
93 allocate(c[*]) ! { dg-error "Sorry" }
94 allocate(b(3)[5:*]) ! { dg-error "Sorry" }
95 allocate(a%a(5)) ! OK
96 end subroutine alloc
97
98
99 subroutine dataPtr()
100   integer, save, target :: a[*]
101   data a/5/ ! OK
102   data a[1]/5/ ! { dg-error "cannot have a coindex" }
103   type t
104   integer, pointer :: p
105   end type t
106   type(t), save :: x[*]
107
108   type t2
109     integer :: a(1)
110   end type t2
111   type(t2) y
112   data y%a/4/
113
114
115    x[1]%p => a  ! { dg-error "shall not have a coindex" }
116    x%p => a[1]  ! { dg-error "shall not have a coindex" }
117 end subroutine dataPtr
118
119
120 subroutine test3()
121 implicit none
122 type t
123   integer :: a(1)
124 end type t
125 type(t), save :: x[*]
126 data x%a/4/
127
128   integer, save :: y(1)[*] !(1)
129   call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" }
130 contains
131   subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" }
132     integer :: a(:)[:]
133   end subroutine sub
134 end subroutine test3
135
136
137 subroutine test4()
138   integer, save :: i[*]
139   integer :: j
140   call foo(i)
141   call foo(j) ! { dg-error "must be a coarray" }
142 contains
143   subroutine foo(a)
144     integer :: a[*]
145   end subroutine foo
146 end subroutine test4
147
148
149 subroutine allocateTest()
150   implicit none
151   real, allocatable,dimension(:,:), codimension[:,:] :: a,b,c
152   integer :: n, q
153   n = 1
154   q = 1
155   allocate(a(n,n)[q,*]) ! { dg-error "Sorry" }
156   allocate(b(n,n)[q,*]) ! { dg-error "Sorry" }
157   allocate(c(n,n)[q,*]) ! { dg-error "Sorry" }
158 end subroutine allocateTest
159
160
161 subroutine testAlloc3
162 implicit none
163 integer, allocatable :: a(:,:,:)[:,:]
164 integer, allocatable, dimension(:),codimension[:] :: b(:,:,:)[:,:]
165 integer, allocatable, dimension(:,:),codimension[:,:,:] :: c
166 integer, allocatable, dimension(:,:),codimension[:,:,:] :: d[:,:]
167 integer, allocatable, dimension(:,:,:),codimension[:,:,:] :: e(:,:)
168 integer, allocatable, dimension(:,:,:),codimension[:,:,:] :: f(:,:)[:,:]
169
170 allocate(a(1,2,3)[4,*]) ! { dg-error "Sorry" }
171 allocate(b(1,2,3)[4,*]) ! { dg-error "Sorry" }
172 allocate(c(1,2)[3,4,*]) ! { dg-error "Sorry" }
173 allocate(d(1,2)[3,*])   ! { dg-error "Sorry" }
174 allocate(e(1,2)[3,4,*]) ! { dg-error "Sorry" }
175 allocate(f(1,2)[3,*]) ! { dg-error "Sorry" }
176 end subroutine testAlloc3
177
178
179 subroutine testAlloc4()
180   implicit none
181   type co_double_3
182     double precision, allocatable :: array(:)
183   end type co_double_3
184   type(co_double_3),save, codimension[*] :: work
185   allocate(work%array(1))
186   print *, size(work%array)
187 end subroutine testAlloc4
188
189 subroutine test5()
190   implicit none
191   integer, save :: i[*]
192   print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" }
193 end subroutine test5
194