Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c95086e.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C95086E.ADA
2
3 -- Grant of Unlimited Rights
4 --
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
14 -- to do so.
15 --
16 -- DISCLAIMER
17 --
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
24 --*
25 -- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED BEFORE OR AFTER THE ENTRY
26 -- CALL FOR IN OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
27 -- FORM OF A TYPE CONVERSION. THE FOLLOWING CASES ARE TESTED:
28 -- (A) OK CASE.
29 -- (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
30 -- COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
31 -- FORMAL INDEX SUBTYPE.
32 -- (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
33 -- COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
34 -- ARRAYS.
35 -- (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
36 -- FORMAL INDEX SUBTYPE.
37 -- (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
38 -- FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
39
40 -- RJW 2/3/86
41 -- TMB 11/15/95 ELIMINATED INCOMPATIBILITY WITH ADA95
42 -- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
43
44 WITH REPORT; USE REPORT;
45 PROCEDURE C95086E IS
46
47 BEGIN
48 TEST ("C95086E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
49 "BEFORE OR AFTER THE ENTRY CALL FOR IN OUT ARRAY " &
50 "PARAMETERS, WITH THE ACTUAL HAVING THE FORM OF A TYPE " &
51 "CONVERSION");
52
53 ---------------------------------------------
54
55 DECLARE -- (A)
56
57 SUBTYPE INDEX IS INTEGER RANGE 1..5;
58 TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
59 OF BOOLEAN;
60 SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3);
61 SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3);
62 AR : ACTUAL := (1..3 => (1..3 => TRUE));
63 CALLED : BOOLEAN := FALSE;
64
65 TASK T IS
66 ENTRY E (X : IN OUT FORMAL);
67 END T;
68
69 TASK BODY T IS
70 BEGIN
71 ACCEPT E (X : IN OUT FORMAL) DO
72 CALLED := TRUE;
73 END E;
74 EXCEPTION
75 WHEN OTHERS =>
76 FAILED ("EXCEPTION RAISED IN TASK - (A)");
77 END T;
78
79 BEGIN -- (A)
80
81 T.E (FORMAL (AR));
82
83 EXCEPTION
84 WHEN CONSTRAINT_ERROR =>
85 IF NOT CALLED THEN
86 FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
87 ELSE
88 FAILED ("EXCEPTION RAISED ON RETURN - (A)");
89 END IF;
90 WHEN OTHERS =>
91 FAILED ("EXCEPTION RAISED - (A)");
92 END; -- (A)
93
94 ---------------------------------------------
95
96 DECLARE -- (B)
97
98 SUBTYPE INDEX IS INTEGER RANGE 1..3;
99 TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN;
100 TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN;
101 AR : ACTUAL := (3..5 => (3..5 => FALSE));
102 CALLED : BOOLEAN := FALSE;
103
104 TASK T IS
105 ENTRY E (X : IN OUT FORMAL);
106 END T;
107
108 TASK BODY T IS
109 BEGIN
110 ACCEPT E (X : IN OUT FORMAL) DO
111 CALLED := TRUE;
112 X(3, 3) := TRUE;
113 END E;
114 EXCEPTION
115 WHEN OTHERS =>
116 FAILED ("EXCEPTION RAISED IN TASK - (B)");
117 END T;
118
119 BEGIN -- (B)
120
121 T.E (FORMAL (AR));
122 IF AR(5, 5) /= TRUE THEN
123 FAILED ("INCORRECT RETURNED VALUE - (B)");
124 END IF;
125
126 EXCEPTION
127 WHEN CONSTRAINT_ERROR =>
128 IF NOT CALLED THEN
129 FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
130 ELSE
131 FAILED ("EXCEPTION RAISED ON RETURN - (B)");
132 END IF;
133 WHEN OTHERS =>
134 FAILED ("EXCEPTION RAISED - (B)");
135 END; -- (B)
136
137 ---------------------------------------------
138
139 DECLARE -- (C)
140
141 SUBTYPE INDEX IS INTEGER RANGE 1..5;
142 TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
143 OF CHARACTER;
144 SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3);
145 AR : ARRAY_TYPE (2..1, 1..3) := (2..1 => (1..3 => ' '));
146 CALLED : BOOLEAN := FALSE;
147
148 TASK T IS
149 ENTRY E (X : IN OUT FORMAL);
150 END T;
151
152 TASK BODY T IS
153 BEGIN
154 ACCEPT E (X : IN OUT FORMAL) DO
155 IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN
156 FAILED ("WRONG BOUNDS PASSED - (C)");
157 END IF;
158 CALLED := TRUE;
159 X := (2..0 => (1..3 => 'A'));
160 END E;
161 EXCEPTION
162 WHEN OTHERS =>
163 FAILED ("EXCEPTION RAISED IN TASK - (C)");
164 END T;
165
166 BEGIN -- (C)
167
168 T.E (FORMAL (AR));
169 IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN
170 FAILED ("BOUNDS CHANGED - (C)");
171 END IF;
172
173 EXCEPTION
174 WHEN CONSTRAINT_ERROR =>
175 IF NOT CALLED THEN
176 FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
177 ELSE
178 FAILED ("EXCEPTION RAISED ON RETURN - (C)");
179 END IF;
180 WHEN OTHERS =>
181 FAILED ("EXCEPTION RAISED - (C)");
182 END; -- (C)
183
184 ---------------------------------------------
185
186 DECLARE -- (D)
187
188 SUBTYPE INDEX IS INTEGER RANGE 1..3;
189 TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1)
190 OF CHARACTER;
191 TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER;
192 AR : ACTUAL := (3..5 => (5..3 => ' '));
193 CALLED : BOOLEAN := FALSE;
194
195 TASK T IS
196 ENTRY E (X : IN OUT FORMAL);
197 END T;
198
199 TASK BODY T IS
200 BEGIN
201 ACCEPT E (X : IN OUT FORMAL) DO
202 IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN
203 FAILED ("WRONG BOUNDS PASSED - (D)");
204 END IF;
205 CALLED := TRUE;
206 X := (1..3 => (3..1 => 'A'));
207 END E;
208 EXCEPTION
209 WHEN OTHERS =>
210 FAILED ("EXCEPTION RAISED IN TASK - (D)");
211 END T;
212
213 BEGIN -- (D)
214
215 T.E (FORMAL (AR));
216 IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN
217 FAILED ("BOUNDS CHANGED - (D)");
218 END IF;
219
220 EXCEPTION
221 WHEN CONSTRAINT_ERROR =>
222 IF NOT CALLED THEN
223 FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
224 ELSE
225 FAILED ("EXCEPTION RAISED ON RETURN - (D)");
226 END IF;
227 WHEN OTHERS =>
228 FAILED ("EXCEPTION RAISED - (D)");
229 END; -- (D)
230
231 ---------------------------------------------
232
233 DECLARE -- (E)
234
235 SUBTYPE INDEX IS INTEGER RANGE 1..3;
236 TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
237 OF CHARACTER;
238 TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2,
239 POSITIVE RANGE 1..3) OF CHARACTER;
240 AR : ACTUAL := (5..2 => (1..3 => ' '));
241 CALLED : BOOLEAN := FALSE;
242
243 TASK T IS
244 ENTRY E (X : IN OUT FORMAL);
245 END T;
246
247 TASK BODY T IS
248 BEGIN
249 ACCEPT E (X : IN OUT FORMAL) DO
250 IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN
251 FAILED ("WRONG BOUNDS PASSED - (E)");
252 END IF;
253 CALLED := TRUE;
254 X := (3..1 => (1..3 => ' '));
255 END E;
256 EXCEPTION
257 WHEN OTHERS =>
258 FAILED ("EXCEPTION RAISED IN TASK - (E)");
259 END T;
260
261 BEGIN -- (E)
262
263 T.E (FORMAL (AR));
264 IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN
265 FAILED ("BOUNDS CHANGED - (E)");
266 END IF;
267
268 EXCEPTION
269 WHEN CONSTRAINT_ERROR =>
270 IF NOT CALLED THEN
271 FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
272 ELSE
273 FAILED ("EXCEPTION RAISED ON RETURN - (E)");
274 END IF;
275 WHEN OTHERS =>
276 FAILED ("EXCEPTION RAISED - (E)");
277 END; -- (E)
278
279 ---------------------------------------------
280
281 RESULT;
282 END C95086E;