3 -- Grant of Unlimited Rights
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
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.
26 -- CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
27 -- ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED
28 -- TASKS TO TERMINATE IF AN EXCEPTION IS RAISED BUT NOT HANDLED IN
29 -- THE NON-MASTER UNIT.
32 -- (A) A SIMPLE TASK ALLOCATOR, IN A BLOCK.
33 -- (B) A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
34 -- (C) A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY, NOT
36 -- (D) A LIMITED PRIVATE TASK ALLOCATOR, IN A TASK BODY, DURING
40 -- TBN 01/20/86 CREATED ORIGINAL TEST.
41 -- JRK 05/01/86 IMPROVED ERROR RECOVERY. FIXED EXCEPTION
42 -- HANDLING. ADDED CASE (D).
43 -- BCB 09/24/87 ADDED A RETURN STATEMENT TO THE HANDLER FOR OTHERS
44 -- IN FUNCTION F, CASE B.
45 -- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X.
48 WITH REPORT
; USE REPORT
;
49 WITH SYSTEM
; USE SYSTEM
;
52 MY_EXCEPTION
: EXCEPTION;
66 TEST
("C94002G", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
67 "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
68 "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
69 "TERMINATE IF AN EXCEPTION IS RAISED BUT NOT " &
70 "HANDLED IN THE NON-MASTER UNIT");
72 --------------------------------------------------
76 TYPE A_T
IS ACCESS TT
;
88 FAILED
("MY_EXCEPTION WAS NOT RAISED IN (A)");
95 IF A1
.ALL'TERMINATED THEN
96 FAILED
("ALLOCATED TASK PREMATURELY TERMINATED - " &
101 FAILED
("UNEXPECTED EXCEPTION IN (A)");
107 --------------------------------------------------
113 FUNCTION F
RETURN INTEGER IS
119 TYPE ART
IS ACCESS RT
;
129 FAILED
("MY_EXCEPTION WAS NOT RAISED IN (B)");
138 IF AR1
.T
'TERMINATED THEN
139 FAILED
("ALLOCATED TASK PREMATURELY " &
145 FAILED
("UNEXPECTED EXCEPTION IN (B)");
158 --------------------------------------------------
162 LOOP_COUNT
: INTEGER := 0;
163 CUT_OFF
: CONSTANT := 60; -- DELAY.
171 LOOP_COUNT1
: INTEGER := 0;
172 CUT_OFF1
: CONSTANT := 60; -- DELAY.
175 TYPE ARAT
IS ACCESS RAT
;
176 TYPE ARR
IS ARRAY (1..1) OF TT
;
185 ENTRY ENT1
(ARA
: OUT ARAT
);
191 ARA2
:= NEW RAT
; -- INITIATE TASK ARA2.T(1).
193 ACCEPT ENT1
(ARA
: OUT ARAT
) DO
196 RAISE MY_EXCEPTION
; -- NOT PROPOGATED.
197 FAILED
("MY_EXCEPTION WAS NOT RAISED IN (C)");
201 TSK1
.ENT1
(ARA1
); -- ARA1.T BECOMES ALIAS FOR ARA2.T.
203 WHILE NOT TSK1
'TERMINATED AND LOOP_COUNT1
< CUT_OFF1
LOOP
204 DELAY 1.0 * Impdef
.One_Second
;
205 LOOP_COUNT1
:= LOOP_COUNT1
+ 1;
208 IF LOOP_COUNT1
>= CUT_OFF1
THEN
209 FAILED
("DEPENDENT TASK TSK1 NOT TERMINATED " &
210 "WITHIN ONE MINUTE - (C)");
213 IF ARA1
.T
(1)'TERMINATED THEN
214 FAILED
("ALLOCATED TASK PREMATURELY TERMINATED " &
222 WHILE NOT TSK
'TERMINATED AND LOOP_COUNT
< CUT_OFF
LOOP
223 DELAY 2.0 * Impdef
.One_Second
;
224 LOOP_COUNT
:= LOOP_COUNT
+ 1;
227 IF LOOP_COUNT
>= CUT_OFF
THEN
228 FAILED
("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
229 "TWO MINUTES - (C)");
234 --------------------------------------------------
238 LOOP_COUNT
: INTEGER := 0;
239 CUT_OFF
: CONSTANT := 60; -- DELAY.
247 LOOP_COUNT1
: INTEGER := 0;
248 CUT_OFF1
: CONSTANT := 60; -- DELAY.
251 TYPE LPT
IS LIMITED PRIVATE;
252 PROCEDURE CALL
(X
: LPT
);
253 PROCEDURE KILL
(X
: LPT
);
254 FUNCTION TERMINATED
(X
: LPT
) RETURN BOOLEAN;
261 TYPE ALPT
IS ACCESS LPT
;
265 PROCEDURE CALL
(X
: LPT
) IS
270 PROCEDURE KILL
(X
: LPT
) IS
275 FUNCTION TERMINATED
(X
: LPT
) RETURN BOOLEAN IS
282 ENTRY ENT1
(ALP
: OUT ALPT
);
289 ALP2
:= NEW LPT
; -- INITIATE TASK ALP2.ALL.
291 ACCEPT ENT1
(ALP
: OUT ALPT
) DO
295 RAISE MY_EXCEPTION
; -- PROPOGATED.
296 FAILED
("MY_EXCEPTION WAS NOT RAISED IN (D)");
301 TSK1
.ENT1
(ALP1
); -- ALP1.ALL BECOMES ALIAS FOR ALP2.ALL.
303 FAILED
("MY_EXCEPTION WAS NOT PROPOGATED TO CALLING " &
309 WHILE NOT TSK1
'TERMINATED AND
310 LOOP_COUNT1
< CUT_OFF1
LOOP
311 DELAY 1.0 * Impdef
.One_Second
;
312 LOOP_COUNT1
:= LOOP_COUNT1
+ 1;
315 IF LOOP_COUNT1
>= CUT_OFF1
THEN
316 FAILED
("DEPENDENT TASK TSK1 NOT TERMINATED " &
317 "WITHIN ONE MINUTE - (D)");
320 IF TERMINATED
(ALP1
.ALL) THEN
321 FAILED
("ALLOCATED TASK PREMATURELY " &
323 ELSE CALL
(ALP1
.ALL);
326 FAILED
("UNEXPECTED EXCEPTION IN (D)");
335 WHILE NOT TSK
'TERMINATED AND LOOP_COUNT
< CUT_OFF
LOOP
336 DELAY 2.0 * Impdef
.One_Second
;
337 LOOP_COUNT
:= LOOP_COUNT
+ 1;
340 IF LOOP_COUNT
>= CUT_OFF
THEN
341 FAILED
("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
342 "TWO MINUTES - (D)");
347 --------------------------------------------------