1-- C94002F.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 A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
26--   ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS
27--   TO TERMINATE IF AN EXCEPTION IS RAISED AND HANDLED IN THE
28--   NON-MASTER UNIT.
29
30-- SUBTESTS ARE:
31--   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
32--   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
33--   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
34
35-- TBN 1/20/86
36-- JRK 5/1/86   IMPROVED ERROR RECOVERY.  FIXED EXCEPTION HANDLING.
37-- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
38
39with Impdef;
40WITH REPORT; USE REPORT;
41WITH SYSTEM; USE SYSTEM;
42PROCEDURE C94002F IS
43
44     MY_EXCEPTION : EXCEPTION;
45
46     TASK TYPE TT IS
47          ENTRY E;
48     END TT;
49
50     TASK BODY TT IS
51     BEGIN
52          ACCEPT E;
53          ACCEPT E;
54     END TT;
55
56
57BEGIN
58     TEST ("C94002F", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
59                      "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
60                      "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
61                      "TERMINATE IF AN EXCEPTION IS RAISED AND " &
62                      "HANDLED IN THE NON-MASTER UNIT");
63
64     --------------------------------------------------
65
66     DECLARE -- (A)
67
68          TYPE A_T IS ACCESS TT;
69          A1 : A_T;
70
71     BEGIN -- (A)
72
73          DECLARE
74               A2 : A_T;
75          BEGIN
76               A2 := NEW TT;
77               A2.ALL.E;
78               A1 := A2;
79               RAISE MY_EXCEPTION;
80               FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");
81          EXCEPTION
82               WHEN MY_EXCEPTION =>
83                    NULL;
84               WHEN OTHERS =>
85                    FAILED ("UNEXPECTED EXCEPTION IN (A)");
86          END;
87
88          IF A1.ALL'TERMINATED THEN
89               FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
90          ELSE A1.ALL.E;
91          END IF;
92
93     END; -- (A)
94
95     --------------------------------------------------
96
97     DECLARE -- (B)
98
99          I : INTEGER;
100
101          FUNCTION F RETURN INTEGER IS
102
103               TYPE RT IS
104                    RECORD
105                         T : TT;
106                    END RECORD;
107               TYPE ART IS ACCESS RT;
108               AR1 : ART;
109
110               PROCEDURE P (AR : OUT ART) IS
111                    AR2 : ART;
112               BEGIN
113                    AR2 := NEW RT;
114                    AR2.T.E;
115                    AR := AR2;
116                    RAISE MY_EXCEPTION;
117                    FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");
118               EXCEPTION
119                    WHEN MY_EXCEPTION =>
120                         NULL;
121                    WHEN OTHERS =>
122                         FAILED ("UNEXPECTED EXCEPTION IN (B)");
123               END P;
124
125          BEGIN
126               P (AR1);
127
128               IF AR1.T'TERMINATED THEN
129                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
130                            "- (B)");
131               ELSE AR1.T.E;
132               END IF;
133
134               RETURN 0;
135          END F;
136
137     BEGIN -- (B)
138
139          I := F;
140
141     END; -- (B)
142
143     --------------------------------------------------
144
145     DECLARE -- (C)
146
147          LOOP_COUNT : INTEGER := 0;
148          CUT_OFF : CONSTANT := 60;                -- DELAY.
149
150          TASK TSK IS
151               ENTRY ENT;
152          END TSK;
153
154          TASK BODY TSK IS
155
156               LOOP_COUNT1 : INTEGER := 0;
157               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
158
159               TYPE RAT;
160               TYPE ARAT IS ACCESS RAT;
161               TYPE ARR IS ARRAY (1..1) OF TT;
162               TYPE RAT IS
163                    RECORD
164                         A : ARAT;
165                         T : ARR;
166                    END RECORD;
167               ARA1 : ARAT;
168
169               TASK TSK1 IS
170                    ENTRY ENT1 (ARA : OUT ARAT);
171               END TSK1;
172
173               TASK BODY TSK1 IS
174                    ARA2 : ARAT;
175               BEGIN
176                    ARA2 := NEW RAT;         -- INITIATE TASK ARA2.T(1).
177                    ARA2.T(1).E;
178                    ACCEPT ENT1 (ARA : OUT ARAT) DO
179                         ARA := ARA2;
180                    END ENT1;
181                    RAISE MY_EXCEPTION;
182                    FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");
183               EXCEPTION
184                    WHEN MY_EXCEPTION =>
185                         NULL;
186                    WHEN OTHERS =>
187                         FAILED ("UNEXPECTED EXCEPTION IN (C)");
188               END TSK1;
189
190          BEGIN
191               TSK1.ENT1 (ARA1);     -- ARA1.T BECOMES ALIAS FOR ARA2.T.
192
193               WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
194                    DELAY 1.0 * Impdef.One_Second;
195                    LOOP_COUNT1 := LOOP_COUNT1 + 1;
196               END LOOP;
197
198               IF LOOP_COUNT1 >= CUT_OFF1 THEN
199                    FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
200                            "WITHIN ONE MINUTE - (C)");
201               END IF;
202
203               IF ARA1.T(1)'TERMINATED THEN
204                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
205                            "- (C)");
206               ELSE ARA1.T(1).E;
207               END IF;
208          END TSK;
209
210     BEGIN -- (C)
211
212          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
213               DELAY 2.0 * Impdef.One_Second;
214               LOOP_COUNT := LOOP_COUNT + 1;
215          END LOOP;
216
217          IF LOOP_COUNT >= CUT_OFF THEN
218               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
219                       "TWO MINUTES - (C)");
220          END IF;
221
222     END; -- (C)
223
224     ---------------------------------------------------------------
225
226     RESULT;
227END C94002F;
228