1 |
694 |
jeremybenn |
! { dg-do compile }
|
2 |
|
|
! { dg-options "-fcoarray=single" }
|
3 |
|
|
!
|
4 |
|
|
! PR fortran/40632
|
5 |
|
|
!
|
6 |
|
|
! CONTIGUOUS compile-time tests
|
7 |
|
|
!
|
8 |
|
|
|
9 |
|
|
! C448: Must be an array with POINTER attribute
|
10 |
|
|
type t1
|
11 |
|
|
integer, contiguous :: ca(5) ! { dg-error "Component .ca. at .1. has the CONTIGUOUS" }
|
12 |
|
|
end type t1
|
13 |
|
|
type t2
|
14 |
|
|
integer, contiguous, allocatable :: cb(:) ! { dg-error "Component .cb. at .1. has the CONTIGUOUS" }
|
15 |
|
|
end type t2
|
16 |
|
|
type t3
|
17 |
|
|
integer, contiguous, pointer :: cc(:) ! OK
|
18 |
|
|
end type t3
|
19 |
|
|
type t4
|
20 |
|
|
integer, pointer, contiguous :: cd ! { dg-error "Component .cd. at .1. has the CONTIGUOUS" }
|
21 |
|
|
end type t4
|
22 |
|
|
end
|
23 |
|
|
|
24 |
|
|
! C530: Must be an array and (a) a POINTER or (b) assumed shape.
|
25 |
|
|
subroutine test(x, y)
|
26 |
|
|
integer, pointer :: x(:)
|
27 |
|
|
integer, intent(in) :: y(:)
|
28 |
|
|
contiguous :: x, y
|
29 |
|
|
|
30 |
|
|
integer, contiguous :: a(5) ! { dg-error ".a. at .1. has the CONTIGUOUS attribute" }
|
31 |
|
|
integer, contiguous, allocatable :: b(:) ! { dg-error ".b. at .1. has the CONTIGUOUS attribute" }
|
32 |
|
|
integer, contiguous, pointer :: c(:) ! OK
|
33 |
|
|
integer, pointer, contiguous :: d ! { dg-error ".d. at .1. has the CONTIGUOUS attribute" }
|
34 |
|
|
end
|
35 |
|
|
|
36 |
|
|
! Pointer assignment check:
|
37 |
|
|
! If the pointer object has the CONTIGUOUS attribute, the pointer target shall be contiguous.
|
38 |
|
|
! Note: This is not compile-time checkable; but F2008, 5.3.7 except in a very few cases.
|
39 |
|
|
subroutine ptr_assign()
|
40 |
|
|
integer, pointer, contiguous :: ptr1(:)
|
41 |
|
|
integer, target :: tgt(5)
|
42 |
|
|
ptr1 => tgt
|
43 |
|
|
end subroutine
|
44 |
|
|
|
45 |
|
|
|
46 |
|
|
! C1239 (R1223) If an actual argument is a nonpointer array that has the ASYNCHRONOUS or VOLATILE
|
47 |
|
|
! attribute but is not simply contiguous (6.5.4), and the corresponding dummy argument has either the
|
48 |
|
|
! VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an assumed-shape array
|
49 |
|
|
! that does not have the CONTIGUOUS attribute.
|
50 |
|
|
|
51 |
|
|
subroutine C1239
|
52 |
|
|
type t
|
53 |
|
|
integer :: e(4)
|
54 |
|
|
end type t
|
55 |
|
|
type(t), volatile :: f
|
56 |
|
|
integer, asynchronous :: a(4), b(4)
|
57 |
|
|
integer, volatile :: c(4), d(4)
|
58 |
|
|
call test (a,b,c) ! OK
|
59 |
|
|
call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }
|
60 |
|
|
call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
|
61 |
|
|
|
62 |
|
|
call test (a,b,f%e) ! OK
|
63 |
|
|
call test (a,f%e,c) ! OK
|
64 |
|
|
call test (f%e,b,c) ! OK
|
65 |
|
|
call test (a,b,f%e(::2)) ! OK
|
66 |
|
|
call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }
|
67 |
|
|
call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
|
68 |
|
|
contains
|
69 |
|
|
subroutine test(u, v, w)
|
70 |
|
|
integer, asynchronous :: u(:), v(*)
|
71 |
|
|
integer, volatile :: w(:)
|
72 |
|
|
contiguous :: u
|
73 |
|
|
end subroutine test
|
74 |
|
|
end subroutine C1239
|
75 |
|
|
|
76 |
|
|
|
77 |
|
|
! C1240 (R1223) If an actual argument is an array pointer that has the ASYNCHRONOUS or VOLATILE
|
78 |
|
|
! attribute but does not have the CONTIGUOUS attribute, and the corresponding dummy argument has
|
79 |
|
|
! either the VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an array pointer
|
80 |
|
|
! or an assumed-shape array that does not have the CONTIGUOUS attribute.
|
81 |
|
|
|
82 |
|
|
subroutine C1240
|
83 |
|
|
type t
|
84 |
|
|
integer,pointer :: e(:)
|
85 |
|
|
end type t
|
86 |
|
|
type(t), volatile :: f
|
87 |
|
|
integer, pointer, asynchronous :: a(:), b(:)
|
88 |
|
|
integer,pointer, volatile :: c(:), d(:)
|
89 |
|
|
call test (a,b,c) ! { dg-error "array without CONTIGUOUS" }
|
90 |
|
|
call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }
|
91 |
|
|
call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
|
92 |
|
|
|
93 |
|
|
call test (a,b,f%e) ! { dg-error "array without CONTIGUOUS" }
|
94 |
|
|
call test (a,f%e,c) ! { dg-error "array without CONTIGUOUS" }
|
95 |
|
|
call test (f%e,b,c) ! { dg-error "array without CONTIGUOUS" }
|
96 |
|
|
call test (a,b,f%e(::2)) ! { dg-error "array without CONTIGUOUS" }
|
97 |
|
|
call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }
|
98 |
|
|
call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
|
99 |
|
|
|
100 |
|
|
call test2(a,b)
|
101 |
|
|
call test3(a,b)
|
102 |
|
|
call test2(c,d)
|
103 |
|
|
call test3(c,d)
|
104 |
|
|
call test2(f%e,d)
|
105 |
|
|
call test3(c,f%e)
|
106 |
|
|
contains
|
107 |
|
|
subroutine test(u, v, w)
|
108 |
|
|
integer, asynchronous :: u(:), v(*)
|
109 |
|
|
integer, volatile :: w(:)
|
110 |
|
|
contiguous :: u
|
111 |
|
|
end subroutine test
|
112 |
|
|
subroutine test2(x,y)
|
113 |
|
|
integer, asynchronous :: x(:)
|
114 |
|
|
integer, volatile :: y(:)
|
115 |
|
|
end subroutine test2
|
116 |
|
|
subroutine test3(x,y)
|
117 |
|
|
integer, pointer, asynchronous :: x(:)
|
118 |
|
|
integer, pointer, volatile :: y(:)
|
119 |
|
|
end subroutine test3
|
120 |
|
|
end subroutine C1240
|
121 |
|
|
|
122 |
|
|
|
123 |
|
|
|
124 |
|
|
! 12.5.2.7 Pointer dummy variables
|
125 |
|
|
! C1241 The actual argument corresponding to a dummy pointer with the CONTIGUOUS attribute shall be
|
126 |
|
|
! simply contiguous (6.5.4).
|
127 |
|
|
|
128 |
|
|
subroutine C1241
|
129 |
|
|
integer, pointer, contiguous :: a(:)
|
130 |
|
|
integer, pointer :: b(:)
|
131 |
|
|
call test(a)
|
132 |
|
|
call test(b) ! { dg-error "must be simply contigous" }
|
133 |
|
|
contains
|
134 |
|
|
subroutine test(x)
|
135 |
|
|
integer, pointer, contiguous :: x(:)
|
136 |
|
|
end subroutine test
|
137 |
|
|
end subroutine C1241
|
138 |
|
|
|
139 |
|
|
|
140 |
|
|
! 12.5.2.8 Coarray dummy variables
|
141 |
|
|
! If the dummy argument is an array coarray that has the CONTIGUOUS attribute or is not of assumed shape,
|
142 |
|
|
! the corresponding actual argument shall be simply contiguous
|
143 |
|
|
|
144 |
|
|
subroutine sect12528(cob)
|
145 |
|
|
integer, save :: coa(6)[*]
|
146 |
|
|
integer :: cob(:)[*]
|
147 |
|
|
|
148 |
|
|
call test(coa)
|
149 |
|
|
call test2(coa)
|
150 |
|
|
call test3(coa)
|
151 |
|
|
|
152 |
|
|
call test(cob) ! { dg-error "must be simply contiguous" }
|
153 |
|
|
call test2(cob) ! { dg-error "must be simply contiguous" }
|
154 |
|
|
call test3(cob)
|
155 |
|
|
contains
|
156 |
|
|
subroutine test(x)
|
157 |
|
|
integer, contiguous :: x(:)[*]
|
158 |
|
|
end subroutine test
|
159 |
|
|
subroutine test2(x)
|
160 |
|
|
integer :: x(*)[*]
|
161 |
|
|
end subroutine test2
|
162 |
|
|
subroutine test3(x)
|
163 |
|
|
integer :: x(:)[*]
|
164 |
|
|
end subroutine test3
|
165 |
|
|
end subroutine sect12528
|
166 |
|
|
|
167 |
|
|
|
168 |
|
|
|
169 |
|
|
subroutine test34
|
170 |
|
|
implicit none
|
171 |
|
|
integer, volatile,pointer :: a(:,:),i
|
172 |
|
|
call foo(a(2,2:3:2)) ! { dg-error "must be simply contigous" }
|
173 |
|
|
contains
|
174 |
|
|
subroutine foo(x)
|
175 |
|
|
integer, pointer, contiguous, volatile :: x(:)
|
176 |
|
|
end subroutine
|
177 |
|
|
end subroutine test34
|