1-- C94002E.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.
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     RENAMED FROM C94006A-B.ADA.  LOWERED THE DELAY VALUES
39--                 AND MODIFIED THE COMMENTS.
40-- JRK 5/1/86      IMPROVED ERROR RECOVERY LOGIC.
41-- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
42
43with Impdef;
44WITH REPORT; USE REPORT;
45WITH SYSTEM; USE SYSTEM;
46PROCEDURE C94002E IS
47
48     TASK TYPE TT IS
49          ENTRY E;
50     END TT;
51
52     TASK BODY TT IS
53     BEGIN
54          ACCEPT E;
55          ACCEPT E;
56     END TT;
57
58
59BEGIN
60     TEST ("C94002E", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
61                      "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
62                      "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
63                      "TERMINATE");
64
65     --------------------------------------------------
66
67     DECLARE -- (A)
68
69          TYPE A_T IS ACCESS TT;
70          A1 : A_T;
71
72     BEGIN -- (A)
73
74          DECLARE
75               A2 : A_T;
76          BEGIN
77               A2 := NEW TT;
78               A2.ALL.E;
79               A1 := A2;
80          END;
81
82          IF A1.ALL'TERMINATED THEN
83               FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
84          ELSE A1.ALL.E;
85          END IF;
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               ELSE AR1.T.E;
119               END IF;
120
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               ELSE ARA1.T(1).E;
187               END IF;
188          END TSK;
189
190     BEGIN -- (C)
191
192          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
193               DELAY 2.0 * Impdef.One_Second;
194               LOOP_COUNT := LOOP_COUNT + 1;
195          END LOOP;
196
197          IF LOOP_COUNT >= CUT_OFF THEN
198               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
199                       "TWO MINUTES - (C)");
200          END IF;
201
202     END; -- (C)
203
204     --------------------------------------------------
205
206     RESULT;
207END C94002E;
208