OSDN Git Service

2010-04-27 Tobias Burnus <burnus@net-b.de>
[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(a%a(5)) ! OK
95 end subroutine alloc
96
97
98 subroutine 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" }
116 end subroutine dataPtr
117
118
119 subroutine test3()
120 implicit none
121 type t
122   integer :: a(1)
123 end type t
124 type(t), save :: x[*]
125 data x%a/4/
126
127   integer, save :: y(1)[*] !(1)
128   call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" }
129 contains
130   subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" }
131     integer :: a(:)[:]
132   end subroutine sub
133 end subroutine test3
134
135
136 subroutine test4()
137   integer, save :: i[*]
138   integer :: j
139   call foo(i)
140   call foo(j) ! { dg-error "must be a coarray" }
141 contains
142   subroutine foo(a)
143     integer :: a[*]
144   end subroutine foo
145 end subroutine test4
146
147
148 subroutine 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,*]) ! { dg-error "Sorry" }
155   allocate(b[q,*]) ! { dg-error "Sorry" }
156   allocate(c[q,*]) ! { dg-error "Sorry" }
157 end subroutine allocateTest
158
159
160 subroutine 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)
168 end subroutine testAlloc4
169
170 subroutine test5()
171   implicit none
172   integer, save :: i[*]
173   print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" }
174 end subroutine test5
175