1-- C94007A.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-- OBJECTIVE:
26--     CHECK THAT A TASK THAT IS DECLARED IN A NON-LIBRARY PACKAGE
27--     (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
28--     BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
29--     OR TASK BODY.
30--     SUBTESTS ARE:
31--       (A)  A SIMPLE TASK OBJECT, IN A VISIBLE PART, IN A BLOCK.
32--       (B)  AN ARRAY OF TASK OBJECT, IN A PRIVATE PART, IN A FUNCTION.
33--       (C)  AN ARRAY OF RECORD OF TASK OBJECT, IN A PACKAGE BODY,
34--            IN A TASK BODY.
35
36-- HISTORY:
37--     JRK 10/13/81
38--     SPS 11/21/82
39--     DHH 09/07/88 REVISED HEADER, ADDED EXCEPTION HANDLERS ON OUTER
40--                  BLOCKS, AND ADDED CASE TO INSURE THAT LEAVING A
41--                  PACKAGE VIA AN EXCEPTION WOULD NOT ABORT TASKS.
42--     PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
43
44with Impdef;
45WITH REPORT; USE REPORT;
46WITH SYSTEM; USE SYSTEM;
47PROCEDURE C94007A IS
48
49     TASK TYPE SYNC IS
50          ENTRY ID (C : CHARACTER);
51          ENTRY INNER;
52          ENTRY OUTER;
53     END SYNC;
54
55     TASK BODY SYNC IS
56          ID_C : CHARACTER;
57     BEGIN
58          ACCEPT ID (C : CHARACTER) DO
59               ID_C := C;
60          END ID;
61          DELAY 1.0 * Impdef.One_Second;
62          SELECT
63               ACCEPT OUTER;
64          OR
65               DELAY 120.0 * Impdef.One_Second;
66               FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
67          END SELECT;
68          ACCEPT INNER;
69     END SYNC;
70
71
72BEGIN
73     TEST ("C94007A", "CHECK THAT A TASK THAT IS DECLARED IN A " &
74                      "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
75                      "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
76                      "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
77                      "BODY, OR TASK BODY");
78
79     --------------------------------------------------
80
81     DECLARE -- (A)
82
83          S : SYNC;
84
85     BEGIN -- (A)
86
87          S.ID ('A');
88
89          DECLARE
90
91               PACKAGE PKG IS
92                    TASK T IS
93                         ENTRY E;
94                    END T;
95               END PKG;
96
97               PACKAGE BODY PKG IS
98                    TASK BODY T IS
99                    BEGIN
100                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
101                    END T;
102               END PKG;            -- PROBABLE OUTER BLOCK POINT.
103
104          BEGIN
105
106               S.OUTER;
107
108          EXCEPTION
109               WHEN TASKING_ERROR => NULL;
110          END;
111
112     EXCEPTION
113          WHEN OTHERS =>
114               FAILED("UNEXPECTED EXCEPTION RAISED - A");
115     END; -- (A)
116
117     --------------------------------------------------
118
119     DECLARE -- (B)
120
121          S : SYNC;
122
123          I : INTEGER;
124
125          FUNCTION F RETURN INTEGER IS
126
127               PACKAGE PKG IS
128               PRIVATE
129                    TASK TYPE TT IS
130                         ENTRY E;
131                    END TT;
132                    A : ARRAY (1..1) OF TT;
133               END PKG;
134
135               PACKAGE BODY PKG IS
136                    TASK BODY TT IS
137                    BEGIN
138                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
139                    END TT;
140               END PKG;            -- PROBABLE OUTER BLOCK POINT.
141
142          BEGIN -- F
143
144               S.OUTER;
145               RETURN 0;
146
147          EXCEPTION
148               WHEN TASKING_ERROR => RETURN 0;
149          END F;
150
151     BEGIN -- (B)
152
153          S.ID ('B');
154          I := F;
155
156     EXCEPTION
157          WHEN OTHERS =>
158               FAILED("UNEXPECTED EXCEPTION RAISED - B");
159
160     END; -- (B)
161
162     --------------------------------------------------
163
164     DECLARE -- (C)
165
166          S : SYNC;
167
168     BEGIN -- (C)
169
170          S.ID ('C');
171
172          DECLARE
173
174               TASK TSK IS
175               END TSK;
176
177               TASK BODY TSK IS
178
179                    PACKAGE PKG IS
180                    END PKG;
181
182                    PACKAGE BODY PKG IS
183                         TASK TYPE TT IS
184                              ENTRY E;
185                         END TT;
186
187                         TYPE RT IS
188                              RECORD
189                                   T : TT;
190                              END RECORD;
191
192                         AR : ARRAY (1..1) OF RT;
193
194                         TASK BODY TT IS
195                         BEGIN
196                              S.INNER;  -- PROBABLE INNER BLOCK POINT.
197                         END TT;
198                    END PKG;            -- PROBABLE OUTER BLOCK POINT.
199
200               BEGIN -- TSK
201
202                    S.OUTER;
203
204               EXCEPTION
205                    WHEN TASKING_ERROR => NULL;
206               END TSK;
207
208          BEGIN
209               NULL;
210          END;
211
212     EXCEPTION
213          WHEN OTHERS =>
214               FAILED("UNEXPECTED EXCEPTION RAISED - C");
215     END; -- (C)
216
217     --------------------------------------------------
218
219     DECLARE -- (D)
220
221     GLOBAL : INTEGER := IDENT_INT(5);
222
223     BEGIN -- (D)
224
225          DECLARE
226
227               PACKAGE PKG IS
228                    TASK T IS
229                         ENTRY E;
230                    END T;
231
232                    TASK T1 IS
233                    END T1;
234               END PKG;
235
236               PACKAGE BODY PKG IS
237                    TASK BODY T IS
238                    BEGIN
239                         ACCEPT E DO
240                              RAISE CONSTRAINT_ERROR;
241                         END E;
242                    END T;
243
244                    TASK BODY T1 IS
245                    BEGIN
246                         DELAY 120.0 * Impdef.One_Second;
247                         GLOBAL := IDENT_INT(1);
248                    END T1;
249
250               BEGIN
251                    T.E;
252
253               END PKG;
254               USE PKG;
255          BEGIN
256               NULL;
257          END;
258
259     EXCEPTION
260          WHEN CONSTRAINT_ERROR =>
261               IF GLOBAL /= IDENT_INT(1) THEN
262                    FAILED("TASK NOT COMPLETED");
263               END IF;
264
265          WHEN OTHERS =>
266               FAILED("UNEXPECTED EXCEPTION RAISED - D");
267     END; -- (D)
268
269     RESULT;
270END C94007A;
271