Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c95008a.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 -- C95008A.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 THE EXCEPTION CONSTRAINT_ERROR IS RAISED FOR AN
26 -- OUT-OF-RANGE INDEX VALUE WHEN REFERENCING AN ENTRY FAMILY,
27 -- EITHER IN AN ACCEPT_STATEMENT OR IN AN ENTRY_CALL.
28
29 -- SUBTESTS ARE:
30 -- (A) INTEGER TYPE, STATIC LOWER BOUND, NO PARAMETERS.
31 -- (B) CHARACTER TYPE, DYNAMIC UPPER BOUND, NO PARAMETERS.
32 -- (C) BOOLEAN TYPE, STATIC NULL RANGE, NO PARAMETERS.
33 -- (D) USER-DEFINED ENUMERATED TYPE, DYNAMIC LOWER BOUND, ONE
34 -- PARAMETER.
35 -- (E) DERIVED INTEGER TYPE, DYNAMIC NULL RANGE, ONE PARAMETER.
36 -- (F) DERIVED USER-DEFINED ENUMERATED TYPE, STATIC UPPER BOUND,
37 -- ONE PARAMETER.
38
39 -- JRK 11/4/81
40 -- JBG 11/11/84
41 -- SAIC 11/14/95 fixed test for 2.0.1
42
43 with Impdef;
44 WITH REPORT; USE REPORT;
45 PROCEDURE C95008A IS
46
47 C_E_NOT_RAISED : BOOLEAN;
48 WRONG_EXC_RAISED : BOOLEAN;
49
50 BEGIN
51 TEST ("C95008A", "OUT-OF-RANGE ENTRY FAMILY INDICES IN " &
52 "ACCEPT_STATEMENTS AND ENTRY_CALLS");
53
54 --------------------------------------------------
55
56 C_E_NOT_RAISED := FALSE;
57 WRONG_EXC_RAISED := FALSE;
58
59 DECLARE -- (A)
60
61 TASK T IS
62 ENTRY E (1..10);
63 ENTRY CONTINUE;
64 END T;
65
66 TASK BODY T IS
67 BEGIN
68 ACCEPT CONTINUE;
69 SELECT
70 ACCEPT E (0);
71 OR
72 DELAY 1.0 * Impdef.One_Second;
73 END SELECT;
74 C_E_NOT_RAISED := TRUE;
75 EXCEPTION
76 WHEN CONSTRAINT_ERROR =>
77 NULL;
78 WHEN OTHERS =>
79 WRONG_EXC_RAISED := TRUE;
80 END T;
81
82 BEGIN -- (A)
83
84 SELECT
85 T.E (0);
86 OR
87 DELAY 15.0 * Impdef.One_Second;
88 END SELECT;
89 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
90 "ENTRY_CALL - (A)");
91 T.CONTINUE;
92
93 EXCEPTION -- (A)
94
95 WHEN CONSTRAINT_ERROR =>
96 T.CONTINUE;
97 WHEN OTHERS =>
98 FAILED ("WRONG EXCEPTION RAISED IN " &
99 "ENTRY_CALL - (A)");
100 T.CONTINUE;
101
102 END; -- (A)
103
104 IF C_E_NOT_RAISED THEN
105 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
106 "ACCEPT_STATEMENT - (A)");
107 END IF;
108
109 IF WRONG_EXC_RAISED THEN
110 FAILED ("WRONG EXCEPTION RAISED IN " &
111 "ACCEPT_STATEMENT - (A)");
112 END IF;
113
114 --------------------------------------------------
115
116 C_E_NOT_RAISED := FALSE;
117 WRONG_EXC_RAISED := FALSE;
118
119 DECLARE -- (B)
120
121 TASK T IS
122 ENTRY E (CHARACTER RANGE 'A'..'Y');
123 ENTRY CONTINUE;
124 END T;
125
126 TASK BODY T IS
127 BEGIN
128 ACCEPT CONTINUE;
129 SELECT
130 ACCEPT E (IDENT_CHAR('Z'));
131 OR
132 DELAY 1.0 * Impdef.One_Second;
133 END SELECT;
134 C_E_NOT_RAISED := TRUE;
135 EXCEPTION
136 WHEN CONSTRAINT_ERROR =>
137 NULL;
138 WHEN OTHERS =>
139 WRONG_EXC_RAISED := TRUE;
140 END T;
141
142 BEGIN -- (B)
143
144 SELECT
145 T.E (IDENT_CHAR('Z'));
146 OR
147 DELAY 15.0 * Impdef.One_Second;
148 END SELECT;
149 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
150 "ENTRY_CALL - (B)");
151 T.CONTINUE;
152
153 EXCEPTION -- (B)
154
155 WHEN CONSTRAINT_ERROR =>
156 T.CONTINUE;
157 WHEN OTHERS =>
158 FAILED ("WRONG EXCEPTION RAISED IN " &
159 "ENTRY_CALL - (B)");
160 T.CONTINUE;
161
162 END; -- (B)
163
164 IF C_E_NOT_RAISED THEN
165 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
166 "ACCEPT_STATEMENT - (B)");
167 END IF;
168
169 IF WRONG_EXC_RAISED THEN
170 FAILED ("WRONG EXCEPTION RAISED IN " &
171 "ACCEPT_STATEMENT - (B)");
172 END IF;
173
174 --------------------------------------------------
175
176 C_E_NOT_RAISED := FALSE;
177 WRONG_EXC_RAISED := FALSE;
178
179 DECLARE -- (C)
180
181 TASK T IS
182 ENTRY E (TRUE..FALSE);
183 ENTRY CONTINUE;
184 END T;
185
186 TASK BODY T IS
187 BEGIN
188 ACCEPT CONTINUE;
189 SELECT
190 ACCEPT E (FALSE);
191 OR
192 DELAY 1.0 * Impdef.One_Second;
193 END SELECT;
194 C_E_NOT_RAISED := TRUE;
195 EXCEPTION
196 WHEN CONSTRAINT_ERROR =>
197 NULL;
198 WHEN OTHERS =>
199 WRONG_EXC_RAISED := TRUE;
200 END T;
201
202 BEGIN -- (C)
203
204 SELECT
205 T.E (TRUE);
206 OR
207 DELAY 15.0 * Impdef.One_Second;
208 END SELECT;
209 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
210 "ENTRY_CALL - (C)");
211 T.CONTINUE;
212
213 EXCEPTION -- (C)
214
215 WHEN CONSTRAINT_ERROR =>
216 T.CONTINUE;
217 WHEN OTHERS =>
218 FAILED ("WRONG EXCEPTION RAISED IN " &
219 "ENTRY_CALL - (C)");
220 T.CONTINUE;
221
222 END; -- (C)
223
224 IF C_E_NOT_RAISED THEN
225 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
226 "ACCEPT_STATEMENT - (C)");
227 END IF;
228
229 IF WRONG_EXC_RAISED THEN
230 FAILED ("WRONG EXCEPTION RAISED IN " &
231 "ACCEPT_STATEMENT - (C)");
232 END IF;
233
234 --------------------------------------------------
235
236 C_E_NOT_RAISED := FALSE;
237 WRONG_EXC_RAISED := FALSE;
238
239 DECLARE -- (D)
240
241 TYPE ET IS (E0, E1, E2);
242 DLB : ET := ET'VAL (IDENT_INT(1)); -- E1.
243
244 TASK T IS
245 ENTRY E (ET RANGE DLB..E2) (I : INTEGER);
246 ENTRY CONTINUE;
247 END T;
248
249 TASK BODY T IS
250 BEGIN
251 ACCEPT CONTINUE;
252 SELECT
253 ACCEPT E (E0) (I : INTEGER);
254 OR
255 DELAY 1.0 * Impdef.One_Second;
256 END SELECT;
257 C_E_NOT_RAISED := TRUE;
258 EXCEPTION
259 WHEN CONSTRAINT_ERROR =>
260 NULL;
261 WHEN OTHERS =>
262 WRONG_EXC_RAISED := TRUE;
263 END T;
264
265 BEGIN -- (D)
266
267 SELECT
268 T.E (E0) (0);
269 OR
270 DELAY 15.0 * Impdef.One_Second;
271 END SELECT;
272 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
273 "ENTRY_CALL - (D)");
274 T.CONTINUE;
275
276 EXCEPTION -- (D)
277
278 WHEN CONSTRAINT_ERROR =>
279 T.CONTINUE;
280 WHEN OTHERS =>
281 FAILED ("WRONG EXCEPTION RAISED IN " &
282 "ENTRY_CALL - (D)");
283 T.CONTINUE;
284
285 END; -- (D)
286
287 IF C_E_NOT_RAISED THEN
288 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
289 "ACCEPT_STATEMENT - (D)");
290 END IF;
291
292 IF WRONG_EXC_RAISED THEN
293 FAILED ("WRONG EXCEPTION RAISED IN " &
294 "ACCEPT_STATEMENT - (D)");
295 END IF;
296
297 --------------------------------------------------
298
299 C_E_NOT_RAISED := FALSE;
300 WRONG_EXC_RAISED := FALSE;
301
302 DECLARE -- (E)
303
304 TYPE D_I IS NEW INTEGER;
305 SUBTYPE DI IS D_I RANGE 3 .. D_I(IDENT_INT(2));
306
307 TASK T IS
308 ENTRY E (DI) (I : INTEGER);
309 ENTRY CONTINUE;
310 END T;
311
312 TASK BODY T IS
313 BEGIN
314 ACCEPT CONTINUE;
315 SELECT
316 ACCEPT E (D_I(3)) (I : INTEGER);
317 OR
318 DELAY 1.0 * Impdef.One_Second;
319 END SELECT;
320 C_E_NOT_RAISED := TRUE;
321 EXCEPTION
322 WHEN CONSTRAINT_ERROR =>
323 NULL;
324 WHEN OTHERS =>
325 WRONG_EXC_RAISED := TRUE;
326 END T;
327
328 BEGIN -- (E)
329
330 SELECT
331 T.E (D_I(2)) (0);
332 OR
333 DELAY 15.0 * Impdef.One_Second;
334 END SELECT;
335 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
336 "ENTRY_CALL - (E)");
337 T.CONTINUE;
338
339 EXCEPTION -- (E)
340
341 WHEN CONSTRAINT_ERROR =>
342 T.CONTINUE;
343 WHEN OTHERS =>
344 FAILED ("WRONG EXCEPTION RAISED IN " &
345 "ENTRY_CALL - (E)");
346 T.CONTINUE;
347
348 END; -- (E)
349
350 IF C_E_NOT_RAISED THEN
351 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
352 "ACCEPT_STATEMENT - (E)");
353 END IF;
354
355 IF WRONG_EXC_RAISED THEN
356 FAILED ("WRONG EXCEPTION RAISED IN " &
357 "ACCEPT_STATEMENT - (E)");
358 END IF;
359
360 --------------------------------------------------
361
362 C_E_NOT_RAISED := FALSE;
363 WRONG_EXC_RAISED := FALSE;
364
365 DECLARE -- (F)
366
367 TYPE ET IS (E0, E1, E2);
368 TYPE D_ET IS NEW ET;
369
370 TASK T IS
371 ENTRY E (D_ET RANGE E0..E1) (I : INTEGER);
372 ENTRY CONTINUE;
373 END T;
374
375 TASK BODY T IS
376 BEGIN
377 ACCEPT CONTINUE;
378 SELECT
379 ACCEPT E (D_ET'(E2)) (I : INTEGER);
380 OR
381 DELAY 1.0 * Impdef.One_Second;
382 END SELECT;
383 C_E_NOT_RAISED := TRUE;
384 EXCEPTION
385 WHEN CONSTRAINT_ERROR =>
386 NULL;
387 WHEN OTHERS =>
388 WRONG_EXC_RAISED := TRUE;
389 END T;
390
391 BEGIN -- (F)
392
393 SELECT
394 T.E (D_ET'(E2)) (0);
395 OR
396 DELAY 15.0 * Impdef.One_Second;
397 END SELECT;
398 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
399 "ENTRY_CALL - (F)");
400 T.CONTINUE;
401
402 EXCEPTION -- (F)
403
404 WHEN CONSTRAINT_ERROR =>
405 T.CONTINUE;
406 WHEN OTHERS =>
407 FAILED ("WRONG EXCEPTION RAISED IN " &
408 "ENTRY_CALL - (F)");
409 T.CONTINUE;
410
411 END; -- (F)
412
413 IF C_E_NOT_RAISED THEN
414 FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
415 "ACCEPT_STATEMENT - (F)");
416 END IF;
417
418 IF WRONG_EXC_RAISED THEN
419 FAILED ("WRONG EXCEPTION RAISED IN " &
420 "ACCEPT_STATEMENT - (F)");
421 END IF;
422
423 --------------------------------------------------
424
425 RESULT;
426 END C95008A;