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.
25 -- CHECK THAT A UNIT WITH DEPENDENT TASKS CREATED BY (LOCAL)
26 -- ALLOCATORS DOES NOT TERMINATE UNTIL ALL DEPENDENT TASKS ARE
29 -- (A, B) A SIMPLE TASK ALLOCATOR, IN A BLOCK.
30 -- (C, D) A RECORD OF TASK ALLOCATOR, IN A FUNCTION.
31 -- (E, F) A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
33 -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
39 -- TBN 8/25/86 REDUCED DELAYS; ADDED LIMITED PRIVATE TYPES;
40 -- INCLUDED EXITS BY RAISING AN EXCEPTION.
41 -- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
44 WITH REPORT
; USE REPORT
;
45 WITH SYSTEM
; USE SYSTEM
;
49 MY_EXCEPTION
: EXCEPTION;
52 ENTRY E
(I
: INTEGER);
54 TYPE T2
IS LIMITED PRIVATE;
55 PROCEDURE CALL_ENTRY
(A
: T2
; B
: INTEGER);
58 ENTRY E
(I
: INTEGER);
66 ACCEPT E
(I
: INTEGER) DO
69 DELAY 30.0 * Impdef
.One_Second
; -- SINCE THE PARENT UNIT HAS HIGHER
70 -- PRIORITY AT THIS POINT, IT WILL
71 -- RECEIVE CONTROL AND TERMINATE IF
72 -- THE ERROR IS PRESENT.
79 ACCEPT E
(I
: INTEGER) DO
82 DELAY 30.0 * Impdef
.One_Second
;
86 PROCEDURE CALL_ENTRY
(A
: T2
; B
: INTEGER) IS
96 TEST
("C94002A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
97 "CREATED BY (LOCAL) ALLOCATORS DOES NOT " &
98 "TERMINATE UNTIL ALL DEPENDENT TASKS " &
101 --------------------------------------------------
102 GLOBAL
:= IDENT_INT
(0);
105 TYPE A_T
IS ACCESS T1
;
110 A
.ALL.E
(IDENT_INT
(1));
115 FAILED
("MY_EXCEPTION WAS NOT RAISED - 1");
119 FAILED
("DEPENDENT TASK NOT TERMINATED BEFORE " &
123 FAILED
("UNEXPECTED EXCEPTION RAISED - 1");
126 --------------------------------------------------
128 GLOBAL
:= IDENT_INT
(0);
131 TYPE A_T
IS ACCESS T2
;
136 CALL_ENTRY
(A
.ALL, IDENT_INT
(2));
141 FAILED
("DEPENDENT TASK NOT TERMINATED BEFORE " &
145 --------------------------------------------------
147 GLOBAL
:= IDENT_INT
(0);
152 FUNCTION F
RETURN INTEGER IS
154 TYPE ART
IS ACCESS RT
;
163 FOR I
IN 1 .. IDENT_INT
(1) LOOP
167 LIST
.T
.E
(IDENT_INT
(3));
175 FAILED
("DEPENDENT TASK NOT TERMINATED BEFORE " &
176 "FUNCTION EXIT - 3");
180 --------------------------------------------------
182 GLOBAL
:= IDENT_INT
(0);
187 FUNCTION F
RETURN INTEGER IS
189 TYPE ART
IS ACCESS RT
;
198 FOR I
IN 1 .. IDENT_INT
(1) LOOP
202 CALL_ENTRY
(LIST
.T
, IDENT_INT
(4));
212 FAILED
("MY_EXCEPTION WAS NOT RAISED - 4");
216 FAILED
("DEPENDENT TASK NOT TERMINATED BEFORE " &
217 "FUNCTION EXIT - 4");
220 FAILED
("UNEXPECTED EXCEPTION RAISED - 4");
223 --------------------------------------------------
225 GLOBAL
:= IDENT_INT
(0);
229 LOOP_COUNT
: INTEGER := 0;
230 CUT_OFF
: CONSTANT := 5 * 60; -- FIVE MINUTE DELAY.
237 TYPE ARR
IS ARRAY (1..1) OF T1
;
239 TYPE ARAT
IS ACCESS RAT
;
248 FOR I
IN 1 .. IDENT_INT
(1) LOOP
252 LIST
.T
(1).E
(IDENT_INT
(5));
261 WHILE NOT TSK
'TERMINATED AND LOOP_COUNT
< CUT_OFF
LOOP
262 DELAY 1.0 * Impdef
.One_Second
;
263 LOOP_COUNT
:= LOOP_COUNT
+ 1;
266 IF LOOP_COUNT
>= CUT_OFF
THEN
267 FAILED
("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
272 FAILED
("DEPENDENT TASK NOT TERMINATED BEFORE " &
278 --------------------------------------------------
280 GLOBAL
:= IDENT_INT
(0);
284 LOOP_COUNT
: INTEGER := 0;
285 CUT_OFF
: CONSTANT := 5 * 60; -- FIVE MINUTE DELAY.
292 TYPE ARR
IS ARRAY (1..1) OF T2
;
294 TYPE ARAT
IS ACCESS RAT
;
303 FOR I
IN 1 .. IDENT_INT
(1) LOOP
307 CALL_ENTRY
(LIST
.T
(1), IDENT_INT
(6));
313 WHILE NOT TSK
'TERMINATED AND LOOP_COUNT
< CUT_OFF
LOOP
314 DELAY 1.0 * Impdef
.One_Second
;
315 LOOP_COUNT
:= LOOP_COUNT
+ 1;
318 IF LOOP_COUNT
>= CUT_OFF
THEN
319 FAILED
("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
324 FAILED
("DEPENDENT TASK NOT TERMINATED BEFORE " &