1-- C94002B.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 MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL ACCESS
26--   TYPE MAY TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS TO
27--   TERMINATE.
28
29-- SUBTESTS ARE:
30--   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
31--   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
32--   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
33
34-- JRK 10/8/81
35-- SPS 11/2/82
36-- SPS 11/21/82
37-- JRK 11/29/82
38-- TBN 1/20/86     REPLACED WITH C94006A-B.ADA AFTER LOWERING THE DELAY
39--                 VALUES, AND MODIFYING THE COMMENTS.
40-- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
41
42with Impdef;
43WITH REPORT; USE REPORT;
44WITH SYSTEM; USE SYSTEM;
45PROCEDURE C94002B IS
46
47     TASK TYPE TT IS
48          ENTRY E;
49     END TT;
50
51     TASK BODY TT IS
52     BEGIN
53          ACCEPT E;
54          ACCEPT E;
55     END TT;
56
57
58BEGIN
59     TEST ("C94002B", "CHECK THAT A MASTER UNIT, WHICH ALLOCATES " &
60                      "TASKS OF A GLOBAL ACCESS TYPE MAY TERMINATE " &
61                      "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
62                      "TERMINATE");
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          END;
80
81          IF A1.ALL'TERMINATED THEN
82               FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
83          END IF;
84
85          A1.ALL.E;
86
87     END; -- (A)
88
89     --------------------------------------------------
90
91     DECLARE -- (B)
92
93          I : INTEGER;
94
95          FUNCTION F RETURN INTEGER IS
96
97               TYPE RT IS
98                    RECORD
99                         T : TT;
100                    END RECORD;
101               TYPE ART IS ACCESS RT;
102               AR1 : ART;
103
104               PROCEDURE P (AR : OUT ART) IS
105                    AR2 : ART;
106               BEGIN
107                    AR2 := NEW RT;
108                    AR2.T.E;
109                    AR := AR2;
110               END P;
111
112          BEGIN
113               P (AR1);
114
115               IF AR1.T'TERMINATED THEN
116                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
117                            "- (B)");
118               END IF;
119
120               AR1.T.E;
121               RETURN 0;
122          END F;
123
124     BEGIN -- (B)
125
126          I := F;
127
128     END; -- (B)
129
130     --------------------------------------------------
131
132     DECLARE -- (C)
133
134          LOOP_COUNT : INTEGER := 0;
135          CUT_OFF : CONSTANT := 60;                -- DELAY.
136
137          TASK TSK IS
138               ENTRY ENT;
139          END TSK;
140
141          TASK BODY TSK IS
142
143               LOOP_COUNT1 : INTEGER := 0;
144               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
145
146               TYPE RAT;
147               TYPE ARAT IS ACCESS RAT;
148               TYPE ARR IS ARRAY (1..1) OF TT;
149               TYPE RAT IS
150                    RECORD
151                         A : ARAT;
152                         T : ARR;
153                    END RECORD;
154               ARA1 : ARAT;
155
156               TASK TSK1 IS
157                    ENTRY ENT1 (ARA : OUT ARAT);
158               END TSK1;
159
160               TASK BODY TSK1 IS
161                    ARA2 : ARAT;
162               BEGIN
163                    ARA2 := NEW RAT;
164                    ARA2.T(1).E;
165                    ACCEPT ENT1 (ARA : OUT ARAT) DO
166                         ARA := ARA2;
167                    END ENT1;
168               END TSK1;
169
170          BEGIN
171               TSK1.ENT1 (ARA1);
172
173               WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
174                    DELAY 1.0 * Impdef.One_Second;
175                    LOOP_COUNT1 := LOOP_COUNT1 + 1;
176               END LOOP;
177
178               IF LOOP_COUNT1 >= CUT_OFF1 THEN
179                    FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
180                            "WITHIN ONE MINUTE - (C)");
181               END IF;
182
183               IF ARA1.T(1)'TERMINATED THEN
184                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
185                            "- (C)");
186               END IF;
187
188               ARA1.T(1).E;
189          END TSK;
190
191     BEGIN -- (C)
192
193          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
194               DELAY 2.0 * Impdef.One_Second;
195               LOOP_COUNT := LOOP_COUNT + 1;
196          END LOOP;
197
198          IF LOOP_COUNT >= CUT_OFF THEN
199               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
200                       "TWO MINUTES - (C)");
201          END IF;
202
203     END; -- (C)
204
205     --------------------------------------------------
206
207     RESULT;
208END C94002B;
209