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