1-- C94001A.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 UNIT WITH DEPENDENT TASKS CREATED BY OBJECT
26--   DECLARATIONS IS NOT TERMINATED UNTIL ALL DEPENDENT TASKS BECOME
27--   TERMINATED.
28-- SUBTESTS ARE:
29--   (A, B)  A SIMPLE TASK OBJECT, IN A BLOCK.
30--   (C, D)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
31--   (E, F)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
32
33-- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
34
35-- JRK 10/2/81
36-- SPS 11/21/82
37-- JRK 11/29/82
38-- TBN  8/22/86     REVISED; ADDED CASES THAT EXIT BY RAISING AN
39--                  EXCEPTION.
40-- PWN 01/31/95     REMOVED PRAGMA PRIORITY FOR ADA 9X.
41
42with Impdef;
43WITH REPORT; USE REPORT;
44WITH SYSTEM; USE SYSTEM;
45PROCEDURE C94001A IS
46
47     MY_EXCEPTION : EXCEPTION;
48     GLOBAL : INTEGER;
49
50     TASK TYPE TT IS
51          ENTRY E (I : INTEGER);
52     END TT;
53
54     TASK BODY TT IS
55          LOCAL : INTEGER;
56     BEGIN
57          ACCEPT E (I : INTEGER) DO
58               LOCAL := I;
59          END E;
60          DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
61                         -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
62                         -- TERMINATE IF THE ERROR IS PRESENT.
63          GLOBAL := LOCAL;
64     END TT;
65
66
67BEGIN
68     TEST ("C94001A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
69                      "CREATED BY OBJECT DECLARATIONS IS NOT " &
70                      "TERMINATED UNTIL ALL DEPENDENT TASKS " &
71                      "BECOME TERMINATED");
72
73     --------------------------------------------------
74
75     GLOBAL := IDENT_INT (0);
76
77     DECLARE -- (A)
78
79          T : TT;
80
81     BEGIN -- (A)
82
83          T.E (IDENT_INT(1));
84
85     END; -- (A)
86
87     IF GLOBAL /= 1 THEN
88          FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
89                  "BLOCK EXIT - 1");
90     END IF;
91
92     --------------------------------------------------
93
94     GLOBAL := IDENT_INT (0);
95
96     BEGIN -- (B)
97          DECLARE
98               T : TT;
99          BEGIN
100               T.E (IDENT_INT(1));
101               RAISE MY_EXCEPTION;
102          END;
103
104          FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
105     EXCEPTION
106          WHEN MY_EXCEPTION =>
107               IF GLOBAL /= 1 THEN
108                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
109                            "BLOCK EXIT - 2");
110               END IF;
111          WHEN OTHERS =>
112               FAILED ("UNEXPECTED EXCEPTION - 2");
113     END; -- (B)
114
115     --------------------------------------------------
116
117     GLOBAL := IDENT_INT (0);
118
119     DECLARE -- (C)
120
121          I : INTEGER;
122
123          FUNCTION F RETURN INTEGER IS
124               A : ARRAY (1..1) OF TT;
125          BEGIN
126               A(1).E (IDENT_INT(2));
127               RETURN 0;
128          END F;
129
130     BEGIN -- (C)
131
132          I := F;
133
134          IF GLOBAL /= 2 THEN
135               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
136                       "FUNCTION EXIT - 3");
137          END IF;
138
139     END; -- (C)
140
141     --------------------------------------------------
142
143     GLOBAL := IDENT_INT (0);
144
145     DECLARE -- (D)
146
147          I : INTEGER;
148
149          FUNCTION F RETURN INTEGER IS
150               A : ARRAY (1..1) OF TT;
151          BEGIN
152               A(1).E (IDENT_INT(2));
153               IF EQUAL (3, 3) THEN
154                    RAISE MY_EXCEPTION;
155               END IF;
156               RETURN 0;
157          END F;
158
159     BEGIN -- (D)
160          I := F;
161          FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
162     EXCEPTION
163          WHEN MY_EXCEPTION =>
164               IF GLOBAL /= 2 THEN
165                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
166                            "FUNCTION EXIT - 4");
167               END IF;
168          WHEN OTHERS =>
169               FAILED ("UNEXPECTED EXCEPTION - 4");
170     END; -- (D)
171
172     --------------------------------------------------
173
174     GLOBAL := IDENT_INT (0);
175
176     DECLARE -- (E)
177
178          LOOP_COUNT : INTEGER := 0;
179          CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
180
181          TASK TSK IS
182               ENTRY ENT;
183          END TSK;
184
185          TASK BODY TSK IS
186               TYPE RT IS
187                    RECORD
188                         T : TT;
189                    END RECORD;
190               AR : ARRAY (1..1) OF RT;
191          BEGIN
192               AR(1).T.E (IDENT_INT(3));
193          END TSK;
194
195     BEGIN -- (E)
196
197          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
198               DELAY 1.0 * Impdef.One_Second;
199               LOOP_COUNT := LOOP_COUNT + 1;
200          END LOOP;
201
202          IF LOOP_COUNT >= CUT_OFF THEN
203               FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
204                       "HOUR - 5");
205          ELSIF GLOBAL /= 3 THEN
206               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
207                       "TASK EXIT - 5");
208          END IF;
209
210     END; -- (E)
211
212     --------------------------------------------------
213
214     GLOBAL := IDENT_INT (0);
215
216     DECLARE -- (F)
217
218          LOOP_COUNT : INTEGER := 0;
219          CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
220
221          TASK TSK IS
222               ENTRY ENT;
223          END TSK;
224
225          TASK BODY TSK IS
226               TYPE RT IS
227                    RECORD
228                         T : TT;
229                    END RECORD;
230               AR : ARRAY (1..1) OF RT;
231          BEGIN
232               AR(1).T.E (IDENT_INT(3));
233               IF EQUAL (3, 3) THEN
234                    RAISE MY_EXCEPTION;
235               END IF;
236               FAILED ("EXCEPTION WAS NOT RAISED - 6");
237          END TSK;
238
239     BEGIN -- (F)
240
241          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
242               DELAY 1.0 * Impdef.One_Second;
243               LOOP_COUNT := LOOP_COUNT + 1;
244          END LOOP;
245
246          IF LOOP_COUNT >= CUT_OFF THEN
247               FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
248                       "HOUR - 6");
249          ELSIF GLOBAL /= 3 THEN
250               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
251                       "TASK EXIT - 6");
252          END IF;
253
254     END; -- (F)
255
256     --------------------------------------------------
257
258     RESULT;
259END C94001A;
260