1-- C9A007A.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 TASK MAY ABORT A TASK IT DEPENDS ON.
26
27
28-- RM 5/26/82
29-- RM 7/02/82
30-- SPS 11/21/82
31-- JBG 2/27/84
32-- JBG 3/8/84
33-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
34-- EDS 08/04/98 ENSURE THAT ABORTED TASKS HAVE TIME TO EFFECT THEIR ABORTIONS.
35
36WITH IMPDEF;
37WITH REPORT; USE REPORT;
38WITH SYSTEM; USE SYSTEM;
39PROCEDURE  C9A007A  IS
40
41      TASK_NOT_ABORTED : BOOLEAN := FALSE;
42      TEST_VALID       : BOOLEAN := TRUE ;
43
44BEGIN
45
46
47     -------------------------------------------------------------------
48
49
50     TEST ( "C9A007A" , "CHECK THAT A TASK MAY ABORT A TASK" &
51                        " IT DEPENDS ON"                     );
52
53
54     DECLARE
55
56
57          TASK  REGISTER  IS
58
59
60               ENTRY  BIRTHS_AND_DEATHS;
61
62               ENTRY  SYNC1;
63               ENTRY  SYNC2;
64
65
66          END  REGISTER;
67
68
69          TASK BODY  REGISTER  IS
70
71
72               TASK TYPE  SECONDARY  IS
73
74
75                    ENTRY  WAIT_INDEFINITELY;
76
77               END  SECONDARY;
78
79
80               TASK TYPE  T_TYPE1  IS
81
82
83                    ENTRY  E;
84
85               END  T_TYPE1;
86
87
88               TASK TYPE  T_TYPE2  IS
89
90
91                    ENTRY  E;
92
93               END  T_TYPE2;
94
95
96               T_OBJECT1 : T_TYPE1;
97               T_OBJECT2 : T_TYPE2;
98
99
100               TASK BODY  SECONDARY  IS
101               BEGIN
102                    SYNC1;
103                    ABORT  T_OBJECT1;
104                    DELAY 0.0;
105                    TASK_NOT_ABORTED  :=  TRUE;
106               END  SECONDARY;
107
108
109               TASK BODY  T_TYPE1  IS
110
111                    TYPE  ACCESS_TO_TASK  IS  ACCESS SECONDARY;
112
113               BEGIN
114
115
116                    DECLARE
117                         DEPENDENT_BY_ACCESS   :  ACCESS_TO_TASK  :=
118                                                  NEW  SECONDARY ;
119                    BEGIN
120                         NULL;
121                    END;
122
123
124                    BIRTHS_AND_DEATHS;
125                                     -- DURING THIS SUSPENSION
126                                     --     MOST OF THE TASKS
127                                     --     ARE ABORTED   (FIRST
128                                     --     TASK #1    -- T_OBJECT1 --
129                                     --     THEN  #2 ).
130
131
132                    TASK_NOT_ABORTED := TRUE;
133
134
135               END  T_TYPE1;
136
137
138               TASK BODY  T_TYPE2  IS
139
140                    TASK  INNER_TASK  IS
141
142
143                         ENTRY  WAIT_INDEFINITELY;
144
145                    END  INNER_TASK;
146
147                    TASK BODY  INNER_TASK  IS
148                    BEGIN
149                         SYNC2;
150                         ABORT  T_OBJECT2;
151                         DELAY 0.0;
152                         TASK_NOT_ABORTED  :=  TRUE;
153                    END  INNER_TASK;
154
155               BEGIN
156
157
158                    BIRTHS_AND_DEATHS;
159                                     -- DURING THIS SUSPENSION
160                                     --     MOST OF THE TASKS
161                                     --     ARE ABORTED   (FIRST
162                                     --     TASK #1     -- T_OBJECT1 --
163                                     --     THEN  #2 ).
164
165
166                    TASK_NOT_ABORTED := TRUE;
167
168
169               END  T_TYPE2;
170
171
172          BEGIN
173
174               DECLARE
175                    OLD_COUNT : INTEGER := 0;
176               BEGIN
177
178
179                    FOR  I  IN  1..5  LOOP
180                         EXIT WHEN  BIRTHS_AND_DEATHS'COUNT = 2;
181                         DELAY 10.0 * Impdef.One_Second;
182                    END LOOP;
183
184                    OLD_COUNT := BIRTHS_AND_DEATHS'COUNT;
185
186                    IF  OLD_COUNT = 2  THEN
187
188                         ACCEPT  SYNC1;   -- ALLOWING  ABORT#1
189
190                         DELAY IMPDEF.CLEAR_READY_QUEUE;
191
192                         -- CHECK THAT  #1  WAS ABORTED  -  3 WAYS:
193
194                         BEGIN
195                              T_OBJECT1.E;
196                              FAILED( "T_OBJECT1.E  DID NOT RAISE" &
197                                                   "  TASKING_ERROR" );
198                         EXCEPTION
199
200                              WHEN TASKING_ERROR  =>
201                                   NULL;
202
203                              WHEN OTHERS  =>
204                                   FAILED("OTHER EXCEPTION RAISED - 1");
205
206                         END;
207
208                         IF T_OBJECT1'CALLABLE  THEN
209                              FAILED( "T_OBJECT1'CALLABLE = TRUE" );
210                         END IF;
211
212                         IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
213                         THEN
214                              FAILED( "TASK#1 NOT REMOVED FROM QUEUE" );
215                         END IF;
216
217
218                         OLD_COUNT := BIRTHS_AND_DEATHS'COUNT;
219
220
221                         ACCEPT  SYNC2;   -- ALLOWING  ABORT#2
222
223                         DELAY IMPDEF.CLEAR_READY_QUEUE;
224
225                         -- CHECK THAT  #2  WAS ABORTED  -  3 WAYS:
226
227                         BEGIN
228                              T_OBJECT2.E;
229                              FAILED( "T_OBJECT2.E  DID NOT RAISE" &
230                                                   "  TASKING_ERROR" );
231                         EXCEPTION
232
233                              WHEN TASKING_ERROR  =>
234                                   NULL;
235
236                              WHEN OTHERS  =>
237                                   FAILED("OTHER EXCEPTION RAISED - 2");
238
239                         END;
240
241                         IF T_OBJECT2'CALLABLE  THEN
242                              FAILED( "T_OBJECT2'CALLABLE = TRUE" );
243                         END IF;
244
245                         IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
246                         THEN
247                              FAILED( "TASK#2 NOT REMOVED FROM QUEUE" );
248                         END IF;
249
250
251                         IF  BIRTHS_AND_DEATHS'COUNT /= 0  THEN
252                              FAILED( "SOME TASKS STILL QUEUED" );
253                         END IF;
254
255
256                    ELSE
257
258                         COMMENT( "LINEUP NOT COMPLETE (AFTER 50 S.)" );
259                         TEST_VALID  :=  FALSE;
260
261                    END IF;
262
263
264               END;
265
266
267               WHILE  BIRTHS_AND_DEATHS'COUNT > 0  LOOP
268                    ACCEPT  BIRTHS_AND_DEATHS;
269               END LOOP;
270
271
272          END  REGISTER;
273
274
275     BEGIN
276
277          NULL;
278
279     END;
280
281
282     -------------------------------------------------------------------
283
284
285     IF  TEST_VALID  AND  TASK_NOT_ABORTED  THEN
286          FAILED( "SOME TASKS NOT ABORTED" );
287     END IF;
288
289
290     RESULT;
291
292
293END  C9A007A;
294