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

  call asyn(volat)
  call asyn(async)
  call asyn(volat[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
  call asyn(async[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }

  call coarray(caf1) ! rank mismatch; OK, for non allocatable coarrays
  call coarray(caf2)
  call coarray(caf2[1]) ! { dg-error "must be a coarray" }
  call ups(i)
  call ups(i[1]) ! { dg-error "with ultimate pointer component" }
  call ups(i%ptr)
  call ups(i[1]%ptr) ! OK - passes target not pointer
contains
  subroutine asyn(a)
    integer, intent(in), asynchronous :: a
  end subroutine asyn
  subroutine bar(a)
    integer :: a
  end subroutine bar
  subroutine foo(a)
    integer, pointer :: a
  end subroutine foo
  subroutine coarray(a)
    integer :: a[*]
  end subroutine coarray
  subroutine typeDummy(a)
    type(t) :: a
  end subroutine typeDummy
  subroutine typeDummy2(a)
    type(t),allocatable :: a
  end subroutine typeDummy2
  subroutine typeDummy3(a)
    type(t3) :: a
  end subroutine typeDummy3
  subroutine typeDummy4(a)
    type(t4), allocatable :: a
  end subroutine typeDummy4
end program test


subroutine alloc()
type t
  integer, allocatable :: a(:)
end type t
type(t), save :: a[*]
type(t), allocatable :: b(:)[:], C[:]

allocate(b(1)) ! { dg-error "Coarray specification" }
allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
allocate(c[*]) ! { dg-error "Sorry" }
allocate(a%a(5)) ! OK
end subroutine alloc


subroutine dataPtr()
  integer, save, target :: a[*]
  data a/5/ ! OK
  data a[1]/5/ ! { dg-error "cannot have a coindex" }
  type t
  integer, pointer :: p
  end type t
  type(t), save :: x[*]

  type t2
    integer :: a(1)
  end type t2
  type(t2) y
  data y%a/4/


   x[1]%p => a  ! { dg-error "shall not have a coindex" }
   x%p => a[1]  ! { dg-error "shall not have a coindex" }
end subroutine dataPtr


subroutine test3()
implicit none
type t
  integer :: a(1)
end type t
type(t), save :: x[*]
data x%a/4/

  integer, save :: y(1)[*] !(1)
  call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" }
contains
  subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" }
    integer :: a(:)[:]
  end subroutine sub
end subroutine test3


subroutine test4()
  integer, save :: i[*]
  integer :: j
  call foo(i)
  call foo(j) ! { dg-error "must be a coarray" }
contains
  subroutine foo(a)
    integer :: a[*]
  end subroutine foo
end subroutine test4


subroutine allocateTest()
  implicit none
  real, allocatable, codimension[:,:] :: a,b,c
  integer :: n, q
  n = 1
  q = 1
  allocate(a[q,*]) ! { dg-error "Sorry" }
  allocate(b[q,*]) ! { dg-error "Sorry" }
  allocate(c[q,*]) ! { dg-error "Sorry" }
end subroutine allocateTest


subroutine testAlloc4()
  implicit none
  type co_double_3
    double precision, allocatable :: array(:)
  end type co_double_3
  type(co_double_3),save, codimension[*] :: work
  allocate(work%array(1))
  print *, size(work%array)
end subroutine testAlloc4

subroutine test5()
  implicit none
  integer, save :: i[*]
  print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" }
end subroutine test5