URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c94002g.ada] - Blame information for rev 720

Details | Compare with Previous | View Log


-- C94002G.ADA
 
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
-- OBJECTIVE:
--     CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
--     ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED
--     TASKS TO TERMINATE IF AN EXCEPTION IS RAISED BUT NOT HANDLED IN
--     THE NON-MASTER UNIT.
 
--     SUBTESTS ARE:
--        (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
--        (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
--        (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY, NOT
--             DURING RENDEZVOUS.
--        (D)  A LIMITED PRIVATE TASK ALLOCATOR, IN A TASK BODY, DURING
--             RENDEZVOUS.
 
-- HISTORY:
--     TBN 01/20/86  CREATED ORIGINAL TEST.
--      JRK 05/01/86  IMPROVED ERROR RECOVERY.  FIXED EXCEPTION
--                    HANDLING.  ADDED CASE (D).
--      BCB 09/24/87  ADDED A RETURN STATEMENT TO THE HANDLER FOR OTHERS
--                    IN FUNCTION F, CASE B.
--      PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
 
with Impdef;
WITH REPORT; USE REPORT;
WITH SYSTEM; USE SYSTEM;
PROCEDURE C94002G IS
 
     MY_EXCEPTION : EXCEPTION;
 
     TASK TYPE TT IS
          ENTRY E;
     END TT;
 
     TASK BODY TT IS
     BEGIN
          ACCEPT E;
          ACCEPT E;
     END TT;
 
 
BEGIN
     TEST ("C94002G", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
                      "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
                      "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
                      "TERMINATE IF AN EXCEPTION IS RAISED BUT NOT " &
                      "HANDLED IN THE NON-MASTER UNIT");
 
     --------------------------------------------------
 
     DECLARE -- (A)
 
          TYPE A_T IS ACCESS TT;
          A1 : A_T;
 
     BEGIN -- (A)
 
          DECLARE
               A2 : A_T;
          BEGIN
               A2 := NEW TT;
               A2.ALL.E;
               A1 := A2;
               RAISE MY_EXCEPTION;
               FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");
          END;
 
          ABORT A1.ALL;
 
     EXCEPTION
          WHEN MY_EXCEPTION =>
               IF A1.ALL'TERMINATED THEN
                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - " &
                            "(A)");
               ELSE A1.ALL.E;
               END IF;
          WHEN OTHERS =>
               FAILED ("UNEXPECTED EXCEPTION IN (A)");
               IF A1 /= NULL THEN
                    ABORT A1.ALL;
               END IF;
     END; -- (A)
 
     --------------------------------------------------
 
     DECLARE -- (B)
 
          I : INTEGER;
 
          FUNCTION F RETURN INTEGER IS
 
               TYPE RT IS
                    RECORD
                         T : TT;
                    END RECORD;
               TYPE ART IS ACCESS RT;
               AR1 : ART;
 
               PROCEDURE P IS
                    AR2 : ART;
               BEGIN
                    AR2 := NEW RT;
                    AR2.T.E;
                    AR1 := AR2;
                    RAISE MY_EXCEPTION;
                    FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");
               END P;
 
          BEGIN
               P;
               ABORT AR1.T;
               RETURN 0;
          EXCEPTION
               WHEN MY_EXCEPTION =>
                    IF AR1.T'TERMINATED THEN
                         FAILED ("ALLOCATED TASK PREMATURELY " &
                                 "TERMINATED - (B)");
                    ELSE AR1.T.E;
                    END IF;
                    RETURN 0;
               WHEN OTHERS =>
                    FAILED ("UNEXPECTED EXCEPTION IN (B)");
                    IF AR1 /= NULL THEN
                         ABORT AR1.T;
                    END IF;
                    RETURN 0;
          END F;
 
     BEGIN -- (B)
 
          I := F;
 
     END; -- (B)
 
     --------------------------------------------------
 
     DECLARE -- (C)
 
          LOOP_COUNT : INTEGER := 0;
          CUT_OFF : CONSTANT := 60;                -- DELAY.
 
          TASK TSK IS
               ENTRY ENT;
          END TSK;
 
          TASK BODY TSK IS
 
               LOOP_COUNT1 : INTEGER := 0;
               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
 
               TYPE RAT;
               TYPE ARAT IS ACCESS RAT;
               TYPE ARR IS ARRAY (1..1) OF TT;
               TYPE RAT IS
                    RECORD
                         A : ARAT;
                         T : ARR;
                    END RECORD;
               ARA1 : ARAT;
 
               TASK TSK1 IS
                    ENTRY ENT1 (ARA : OUT ARAT);
               END TSK1;
 
               TASK BODY TSK1 IS
                    ARA2 : ARAT;
               BEGIN
                    ARA2 := NEW RAT;         -- INITIATE TASK ARA2.T(1).
                    ARA2.T(1).E;
                    ACCEPT ENT1 (ARA : OUT ARAT) DO
                         ARA := ARA2;
                    END ENT1;
                    RAISE MY_EXCEPTION;       -- NOT PROPOGATED.
                    FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");
               END TSK1;
 
          BEGIN
               TSK1.ENT1 (ARA1);     -- ARA1.T BECOMES ALIAS FOR ARA2.T.
 
               WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
                    DELAY 1.0 * Impdef.One_Second;
                    LOOP_COUNT1 := LOOP_COUNT1 + 1;
               END LOOP;
 
               IF LOOP_COUNT1 >= CUT_OFF1 THEN
                    FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
                            "WITHIN ONE MINUTE - (C)");
               END IF;
 
               IF ARA1.T(1)'TERMINATED THEN
                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
                            "- (C)");
               ELSE ARA1.T(1).E;
               END IF;
          END TSK;
 
     BEGIN -- (C)
 
          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
               DELAY 2.0 * Impdef.One_Second;
               LOOP_COUNT := LOOP_COUNT + 1;
          END LOOP;
 
          IF LOOP_COUNT >= CUT_OFF THEN
               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
                       "TWO MINUTES - (C)");
          END IF;
 
     END; -- (C)
 
     --------------------------------------------------
 
     DECLARE -- (D)
 
          LOOP_COUNT : INTEGER := 0;
          CUT_OFF : CONSTANT := 60;                -- DELAY.
 
          TASK TSK IS
               ENTRY ENT;
          END TSK;
 
          TASK BODY TSK IS
 
               LOOP_COUNT1 : INTEGER := 0;
               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
 
               PACKAGE PKG IS
                    TYPE LPT IS LIMITED PRIVATE;
                    PROCEDURE CALL (X : LPT);
                    PROCEDURE KILL (X : LPT);
                    FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN;
               PRIVATE
                    TYPE LPT IS NEW TT;
               END PKG;
 
               USE PKG;
 
               TYPE ALPT IS ACCESS LPT;
               ALP1 : ALPT;
 
               PACKAGE BODY PKG IS
                    PROCEDURE CALL (X : LPT) IS
                    BEGIN
                         X.E;
                    END CALL;
 
                    PROCEDURE KILL (X : LPT) IS
                    BEGIN
                         ABORT X;
                    END KILL;
 
                    FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN IS
                    BEGIN
                         RETURN X'TERMINATED;
                    END TERMINATED;
               END PKG;
 
               TASK TSK1 IS
                    ENTRY ENT1 (ALP : OUT ALPT);
                    ENTRY DIE;
               END TSK1;
 
               TASK BODY TSK1 IS
                    ALP2 : ALPT;
               BEGIN
                    ALP2 := NEW LPT;         -- INITIATE TASK ALP2.ALL.
                    CALL (ALP2.ALL);
                    ACCEPT ENT1 (ALP : OUT ALPT) DO
                         ALP := ALP2;
                    END ENT1;
                    ACCEPT DIE DO
                         RAISE MY_EXCEPTION;       -- PROPOGATED.
                         FAILED ("MY_EXCEPTION WAS NOT RAISED IN (D)");
                    END DIE;
               END TSK1;
 
          BEGIN
               TSK1.ENT1 (ALP1); -- ALP1.ALL BECOMES ALIAS FOR ALP2.ALL.
               TSK1.DIE;
               FAILED ("MY_EXCEPTION WAS NOT PROPOGATED TO CALLING " &
                       "TASK - (D)");
               KILL (ALP1.ALL);
               ABORT TSK1;
          EXCEPTION
               WHEN MY_EXCEPTION =>
                    WHILE NOT TSK1'TERMINATED AND
                          LOOP_COUNT1 < CUT_OFF1 LOOP
                         DELAY 1.0 * Impdef.One_Second;
                         LOOP_COUNT1 := LOOP_COUNT1 + 1;
                    END LOOP;
 
                    IF LOOP_COUNT1 >= CUT_OFF1 THEN
                         FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
                                 "WITHIN ONE MINUTE - (D)");
                    END IF;
 
                    IF TERMINATED (ALP1.ALL) THEN
                         FAILED ("ALLOCATED TASK PREMATURELY " &
                                 "TERMINATED - (D)");
                    ELSE CALL (ALP1.ALL);
                    END IF;
               WHEN OTHERS =>
                    FAILED ("UNEXPECTED EXCEPTION IN (D)");
                    IF ALP1 /= NULL THEN
                         KILL (ALP1.ALL);
                    END IF;
                    ABORT TSK1;
          END TSK;
 
     BEGIN -- (D)
 
          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
               DELAY 2.0 * Impdef.One_Second;
               LOOP_COUNT := LOOP_COUNT + 1;
          END LOOP;
 
          IF LOOP_COUNT >= CUT_OFF THEN
               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
                       "TWO MINUTES - (D)");
          END IF;
 
     END; -- (D)
 
     --------------------------------------------------
 
     RESULT;
END C94002G;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c94002g.ada] - Blame information for rev 720

Line No.	Rev	Author	Line
1	720	jeremybenn	`-- C94002G.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			`-- OBJECTIVE:`
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.`
30
31			`-- SUBTESTS ARE:`
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`
35			`-- DURING RENDEZVOUS.`
36			`-- (D) A LIMITED PRIVATE TASK ALLOCATOR, IN A TASK BODY, DURING`
37			`-- RENDEZVOUS.`
38
39			`-- HISTORY:`
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.`
46
47			`with Impdef;`
48			`WITH REPORT; USE REPORT;`
49			`WITH SYSTEM; USE SYSTEM;`
50			`PROCEDURE C94002G IS`
51
52			`MY_EXCEPTION : EXCEPTION;`
53
54			`TASK TYPE TT IS`
55			`ENTRY E;`
56			`END TT;`
57
58			`TASK BODY TT IS`
59			`BEGIN`
60			`ACCEPT E;`
61			`ACCEPT E;`
62			`END TT;`
63
64
65			`BEGIN`
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");`
71
72			`--------------------------------------------------`
73
74			`DECLARE -- (A)`
75
76			`TYPE A_T IS ACCESS TT;`
77			`A1 : A_T;`
78
79			`BEGIN -- (A)`
80
81			`DECLARE`
82			`A2 : A_T;`
83			`BEGIN`
84			`A2 := NEW TT;`
85			`A2.ALL.E;`
86			`A1 := A2;`
87			`RAISE MY_EXCEPTION;`
88			`FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");`
89			`END;`
90
91			`ABORT A1.ALL;`
92
93			`EXCEPTION`
94			`WHEN MY_EXCEPTION =>`
95			`IF A1.ALL'TERMINATED THEN`
96			`FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - " &`
97			`"(A)");`
98			`ELSE A1.ALL.E;`
99			`END IF;`
100			`WHEN OTHERS =>`
101			`FAILED ("UNEXPECTED EXCEPTION IN (A)");`
102			`IF A1 /= NULL THEN`
103			`ABORT A1.ALL;`
104			`END IF;`
105			`END; -- (A)`
106
107			`--------------------------------------------------`
108
109			`DECLARE -- (B)`
110
111			`I : INTEGER;`
112
113			`FUNCTION F RETURN INTEGER IS`
114
115			`TYPE RT IS`
116			`RECORD`
117			`T : TT;`
118			`END RECORD;`
119			`TYPE ART IS ACCESS RT;`
120			`AR1 : ART;`
121
122			`PROCEDURE P IS`
123			`AR2 : ART;`
124			`BEGIN`
125			`AR2 := NEW RT;`
126			`AR2.T.E;`
127			`AR1 := AR2;`
128			`RAISE MY_EXCEPTION;`
129			`FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");`
130			`END P;`
131
132			`BEGIN`
133			`P;`
134			`ABORT AR1.T;`
135			`RETURN 0;`
136			`EXCEPTION`
137			`WHEN MY_EXCEPTION =>`
138			`IF AR1.T'TERMINATED THEN`
139			`FAILED ("ALLOCATED TASK PREMATURELY " &`
140			`"TERMINATED - (B)");`
141			`ELSE AR1.T.E;`
142			`END IF;`
143			`RETURN 0;`
144			`WHEN OTHERS =>`
145			`FAILED ("UNEXPECTED EXCEPTION IN (B)");`
146			`IF AR1 /= NULL THEN`
147			`ABORT AR1.T;`
148			`END IF;`
149			`RETURN 0;`
150			`END F;`
151
152			`BEGIN -- (B)`
153
154			`I := F;`
155
156			`END; -- (B)`
157
158			`--------------------------------------------------`
159
160			`DECLARE -- (C)`
161
162			`LOOP_COUNT : INTEGER := 0;`
163			`CUT_OFF : CONSTANT := 60; -- DELAY.`
164
165			`TASK TSK IS`
166			`ENTRY ENT;`
167			`END TSK;`
168
169			`TASK BODY TSK IS`
170
171			`LOOP_COUNT1 : INTEGER := 0;`
172			`CUT_OFF1 : CONSTANT := 60; -- DELAY.`
173
174			`TYPE RAT;`
175			`TYPE ARAT IS ACCESS RAT;`
176			`TYPE ARR IS ARRAY (1..1) OF TT;`
177			`TYPE RAT IS`
178			`RECORD`
179			`A : ARAT;`
180			`T : ARR;`
181			`END RECORD;`
182			`ARA1 : ARAT;`
183
184			`TASK TSK1 IS`
185			`ENTRY ENT1 (ARA : OUT ARAT);`
186			`END TSK1;`
187
188			`TASK BODY TSK1 IS`
189			`ARA2 : ARAT;`
190			`BEGIN`
191			`ARA2 := NEW RAT; -- INITIATE TASK ARA2.T(1).`
192			`ARA2.T(1).E;`
193			`ACCEPT ENT1 (ARA : OUT ARAT) DO`
194			`ARA := ARA2;`
195			`END ENT1;`
196			`RAISE MY_EXCEPTION; -- NOT PROPOGATED.`
197			`FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");`
198			`END TSK1;`
199
200			`BEGIN`
201			`TSK1.ENT1 (ARA1); -- ARA1.T BECOMES ALIAS FOR ARA2.T.`
202
203			`WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP`
204			`DELAY 1.0 * Impdef.One_Second;`
205			`LOOP_COUNT1 := LOOP_COUNT1 + 1;`
206			`END LOOP;`
207
208			`IF LOOP_COUNT1 >= CUT_OFF1 THEN`
209			`FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &`
210			`"WITHIN ONE MINUTE - (C)");`
211			`END IF;`
212
213			`IF ARA1.T(1)'TERMINATED THEN`
214			`FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &`
215			`"- (C)");`
216			`ELSE ARA1.T(1).E;`
217			`END IF;`
218			`END TSK;`
219
220			`BEGIN -- (C)`
221
222			`WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP`
223			`DELAY 2.0 * Impdef.One_Second;`
224			`LOOP_COUNT := LOOP_COUNT + 1;`
225			`END LOOP;`
226
227			`IF LOOP_COUNT >= CUT_OFF THEN`
228			`FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &`
229			`"TWO MINUTES - (C)");`
230			`END IF;`
231
232			`END; -- (C)`
233
234			`--------------------------------------------------`
235
236			`DECLARE -- (D)`
237
238			`LOOP_COUNT : INTEGER := 0;`
239			`CUT_OFF : CONSTANT := 60; -- DELAY.`
240
241			`TASK TSK IS`
242			`ENTRY ENT;`
243			`END TSK;`
244
245			`TASK BODY TSK IS`
246
247			`LOOP_COUNT1 : INTEGER := 0;`
248			`CUT_OFF1 : CONSTANT := 60; -- DELAY.`
249
250			`PACKAGE PKG IS`
251			`TYPE LPT IS LIMITED PRIVATE;`
252			`PROCEDURE CALL (X : LPT);`
253			`PROCEDURE KILL (X : LPT);`
254			`FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN;`
255			`PRIVATE`
256			`TYPE LPT IS NEW TT;`
257			`END PKG;`
258
259			`USE PKG;`
260
261			`TYPE ALPT IS ACCESS LPT;`
262			`ALP1 : ALPT;`
263
264			`PACKAGE BODY PKG IS`
265			`PROCEDURE CALL (X : LPT) IS`
266			`BEGIN`
267			`X.E;`
268			`END CALL;`
269
270			`PROCEDURE KILL (X : LPT) IS`
271			`BEGIN`
272			`ABORT X;`
273			`END KILL;`
274
275			`FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN IS`
276			`BEGIN`
277			`RETURN X'TERMINATED;`
278			`END TERMINATED;`
279			`END PKG;`
280
281			`TASK TSK1 IS`
282			`ENTRY ENT1 (ALP : OUT ALPT);`
283			`ENTRY DIE;`
284			`END TSK1;`
285
286			`TASK BODY TSK1 IS`
287			`ALP2 : ALPT;`
288			`BEGIN`
289			`ALP2 := NEW LPT; -- INITIATE TASK ALP2.ALL.`
290			`CALL (ALP2.ALL);`
291			`ACCEPT ENT1 (ALP : OUT ALPT) DO`
292			`ALP := ALP2;`
293			`END ENT1;`
294			`ACCEPT DIE DO`
295			`RAISE MY_EXCEPTION; -- PROPOGATED.`
296			`FAILED ("MY_EXCEPTION WAS NOT RAISED IN (D)");`
297			`END DIE;`
298			`END TSK1;`
299
300			`BEGIN`
301			`TSK1.ENT1 (ALP1); -- ALP1.ALL BECOMES ALIAS FOR ALP2.ALL.`
302			`TSK1.DIE;`
303			`FAILED ("MY_EXCEPTION WAS NOT PROPOGATED TO CALLING " &`
304			`"TASK - (D)");`
305			`KILL (ALP1.ALL);`
306			`ABORT TSK1;`
307			`EXCEPTION`
308			`WHEN MY_EXCEPTION =>`
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;`
313			`END LOOP;`
314
315			`IF LOOP_COUNT1 >= CUT_OFF1 THEN`
316			`FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &`
317			`"WITHIN ONE MINUTE - (D)");`
318			`END IF;`
319
320			`IF TERMINATED (ALP1.ALL) THEN`
321			`FAILED ("ALLOCATED TASK PREMATURELY " &`
322			`"TERMINATED - (D)");`
323			`ELSE CALL (ALP1.ALL);`
324			`END IF;`
325			`WHEN OTHERS =>`
326			`FAILED ("UNEXPECTED EXCEPTION IN (D)");`
327			`IF ALP1 /= NULL THEN`
328			`KILL (ALP1.ALL);`
329			`END IF;`
330			`ABORT TSK1;`
331			`END TSK;`
332
333			`BEGIN -- (D)`
334
335			`WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP`
336			`DELAY 2.0 * Impdef.One_Second;`
337			`LOOP_COUNT := LOOP_COUNT + 1;`
338			`END LOOP;`
339
340			`IF LOOP_COUNT >= CUT_OFF THEN`
341			`FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &`
342			`"TWO MINUTES - (D)");`
343			`END IF;`
344
345			`END; -- (D)`
346
347			`--------------------------------------------------`
348
349			`RESULT;`
350			`END C94002G;`