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
43with Impdef;
44WITH REPORT; USE REPORT;
45PROCEDURE C95008A IS
46
47     C_E_NOT_RAISED : BOOLEAN;
48     WRONG_EXC_RAISED : BOOLEAN;
49
50BEGIN
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;
426END C95008A;
427