1-- C94007B.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 TASK THAT IS ALLOCATED IN A NON-LIBRARY PACKAGE
26--   (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
27--   BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
28--   OR TASK BODY.
29-- SUBTESTS ARE:
30--   (A)  A SIMPLE TASK ALLOCATOR, IN A VISIBLE PART, IN A BLOCK.
31--   (B)  A RECORD OF TASK ALLOCATOR, IN A PRIVATE PART, IN A FUNCTION.
32--   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY,
33--           IN A TASK BODY.
34
35-- JRK 10/16/81
36-- SPS 11/2/82
37-- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
38
39with Impdef;
40WITH REPORT; USE REPORT;
41WITH SYSTEM; USE SYSTEM;
42PROCEDURE C94007B IS
43
44     TASK TYPE SYNC IS
45          ENTRY ID (C : CHARACTER);
46          ENTRY INNER;
47          ENTRY OUTER;
48     END SYNC;
49
50     TASK BODY SYNC IS
51          ID_C : CHARACTER;
52     BEGIN
53          ACCEPT ID (C : CHARACTER) DO
54               ID_C := C;
55          END ID;
56          DELAY 1.0 * Impdef.One_Second;
57          SELECT
58               ACCEPT OUTER;
59          OR
60               DELAY 120.0 * Impdef.One_Second;
61               FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
62          END SELECT;
63          ACCEPT INNER;
64     END SYNC;
65
66
67BEGIN
68     TEST ("C94007B", "CHECK THAT A TASK THAT IS ALLOCATED IN A " &
69                      "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
70                      "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
71                      "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
72                      "BODY, OR TASK BODY");
73
74     --------------------------------------------------
75
76     DECLARE -- (A)
77
78          S : SYNC;
79
80     BEGIN -- (A)
81
82          S.ID ('A');
83
84          DECLARE
85
86               PACKAGE PKG IS
87                    TASK TYPE TT IS
88                         ENTRY E;
89                    END TT;
90                    TYPE A_T IS ACCESS TT;
91                    A : A_T;
92               END PKG;
93
94               PACKAGE BODY PKG IS
95                    TASK BODY TT IS
96                    BEGIN
97                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
98                    END TT;
99               BEGIN
100                    A := NEW TT;
101               END PKG;            -- PROBABLE OUTER BLOCK POINT.
102
103          BEGIN
104
105               S.OUTER;
106
107          EXCEPTION
108               WHEN TASKING_ERROR => NULL;
109          END;
110
111     END; -- (A)
112
113     --------------------------------------------------
114
115     DECLARE -- (B)
116
117          S : SYNC;
118
119          I : INTEGER;
120
121          FUNCTION F RETURN INTEGER IS
122
123               PACKAGE PKG IS
124               PRIVATE
125                    TASK TYPE TT IS
126                         ENTRY E;
127                    END TT;
128
129                    TYPE RT IS
130                         RECORD
131                              T : TT;
132                         END RECORD;
133
134                    TYPE ART IS ACCESS RT;
135
136                    AR : ART;
137               END PKG;
138
139               PACKAGE BODY PKG IS
140                    TASK BODY TT IS
141                    BEGIN
142                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
143                    END TT;
144               BEGIN
145                    AR := NEW RT;
146               END PKG;            -- PROBABLE OUTER BLOCK POINT.
147
148          BEGIN -- F
149
150               S.OUTER;
151               RETURN 0;
152
153          EXCEPTION
154               WHEN TASKING_ERROR => RETURN 0;
155          END F;
156
157     BEGIN -- (B)
158
159          S.ID ('B');
160          I := F ;
161
162     END; -- (B)
163
164     --------------------------------------------------
165
166     DECLARE -- (C)
167
168          S : SYNC;
169
170     BEGIN -- (C)
171
172          S.ID ('C');
173
174          DECLARE
175
176               TASK TSK IS
177               END TSK;
178
179               TASK BODY TSK IS
180
181                    PACKAGE PKG IS
182                    END PKG;
183
184                    PACKAGE BODY PKG IS
185                         TASK TYPE TT IS
186                              ENTRY E;
187                         END TT;
188
189                         TYPE ARR IS ARRAY (1..1) OF TT;
190                         TYPE RAT IS
191                              RECORD
192                                   T : ARR;
193                              END RECORD;
194
195                         TYPE ARAT IS ACCESS RAT;
196
197                         ARA : ARAT;
198
199                         TASK BODY TT IS
200                         BEGIN
201                              S.INNER;  -- PROBABLE INNER BLOCK POINT.
202                         END TT;
203                    BEGIN
204                         ARA := NEW RAT;
205                    END PKG;            -- PROBABLE OUTER BLOCK POINT.
206
207               BEGIN -- TSK
208
209                    S.OUTER;
210
211               EXCEPTION
212                    WHEN TASKING_ERROR => NULL;
213               END TSK;
214
215          BEGIN
216               NULL;
217          END;
218
219     END; -- (C)
220
221     --------------------------------------------------
222
223     RESULT;
224END C94007B;
225