1-- C94010A.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 IF A GENERIC UNIT HAS A FORMAL LIMITED PRIVATE TYPE AND
26-- DECLARES AN OBJECT OF THAT TYPE (OR HAS A SUBCOMPONENT OF THAT TYPE),
27-- AND IF THE UNIT IS INSTANTIATED WITH A TASK TYPE OR AN OBJECT HAVING
28-- A SUBCOMPONENT OF A TASK TYPE, THEN THE USUAL RULES APPLY TO THE
29-- INSTANTIATED UNIT, NAMELY:
30--     A) IF THE GENERIC UNIT IS A SUBPROGRAM, CONTROL CANNOT LEAVE THE
31--        SUBPROGRAM UNTIL THE TASK CREATED BY THE OBJECT DECLARATION IS
32--        TERMINATED.
33
34-- THIS TEST CONTAINS RACE CONDITIONS AND SHARED VARIABLES.
35
36-- TBN  9/22/86
37-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
38
39with Impdef;
40WITH REPORT; USE REPORT;
41WITH SYSTEM; USE SYSTEM;
42PROCEDURE C94010A IS
43
44     GLOBAL_INT : INTEGER := 0;
45     MY_EXCEPTION : EXCEPTION;
46
47     PACKAGE P IS
48          TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
49     PRIVATE
50          TASK TYPE LIM_PRI_TASK IS
51          END LIM_PRI_TASK;
52     END P;
53
54     USE P;
55
56     TASK TYPE TT IS
57     END TT;
58
59     TYPE REC IS
60          RECORD
61               A : INTEGER := 1;
62               B : TT;
63          END RECORD;
64
65     TYPE LIM_REC IS
66          RECORD
67               A : INTEGER := 1;
68               B : LIM_PRI_TASK;
69          END RECORD;
70
71     PACKAGE BODY P IS
72          TASK BODY LIM_PRI_TASK IS
73          BEGIN
74               DELAY 30.0 * Impdef.One_Second;
75               GLOBAL_INT := IDENT_INT (2);
76          END LIM_PRI_TASK;
77     END P;
78
79     TASK BODY TT IS
80     BEGIN
81          DELAY 30.0 * Impdef.One_Second;
82          GLOBAL_INT := IDENT_INT (1);
83     END TT;
84
85     GENERIC
86          TYPE T IS LIMITED PRIVATE;
87     PROCEDURE PROC (A : INTEGER);
88
89     PROCEDURE PROC (A : INTEGER) IS
90          OBJ_T : T;
91     BEGIN
92          IF A = IDENT_INT (1) THEN
93               RAISE MY_EXCEPTION;
94          END IF;
95     END PROC;
96
97     GENERIC
98          TYPE T IS LIMITED PRIVATE;
99     FUNCTION FUNC (A : INTEGER) RETURN INTEGER;
100
101     FUNCTION FUNC (A : INTEGER) RETURN INTEGER IS
102          OBJ_T : T;
103     BEGIN
104          IF A = IDENT_INT (1) THEN
105               RAISE MY_EXCEPTION;
106          END IF;
107          RETURN 1;
108     END FUNC;
109
110
111BEGIN
112     TEST ("C94010A", "CHECK TERMINATION RULES FOR INSTANTIATIONS OF " &
113                      "GENERIC SUBPROGRAM UNITS WHICH CREATE TASKS");
114
115     -------------------------------------------------------------------
116     DECLARE
117          PROCEDURE PROC1 IS NEW PROC (TT);
118     BEGIN
119          PROC1 (0);
120          IF GLOBAL_INT = IDENT_INT (0) THEN
121               FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
122               DELAY 35.0;
123          END IF;
124     END;
125
126     -------------------------------------------------------------------
127     GLOBAL_INT := IDENT_INT (0);
128
129     DECLARE
130          PROCEDURE PROC2 IS NEW PROC (REC);
131     BEGIN
132          PROC2 (1);
133          FAILED ("EXCEPTION WAS NOT RAISED - 2");
134     EXCEPTION
135          WHEN MY_EXCEPTION =>
136               IF GLOBAL_INT = IDENT_INT (0) THEN
137                    FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
138                    DELAY 35.0 * Impdef.One_Second;
139               END IF;
140          WHEN OTHERS =>
141               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
142     END;
143
144     -------------------------------------------------------------------
145     GLOBAL_INT := IDENT_INT (0);
146
147     DECLARE
148          PROCEDURE PROC3 IS NEW PROC (LIM_PRI_TASK);
149     BEGIN
150          PROC3 (1);
151          FAILED ("EXCEPTION WAS NOT RAISED - 3");
152     EXCEPTION
153          WHEN MY_EXCEPTION =>
154               IF GLOBAL_INT = IDENT_INT (0) THEN
155                    FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
156                    DELAY 35.0 * Impdef.One_Second;
157               END IF;
158          WHEN OTHERS =>
159               FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
160     END;
161
162     -------------------------------------------------------------------
163     GLOBAL_INT := IDENT_INT (0);
164
165     DECLARE
166          PROCEDURE PROC4 IS NEW PROC (LIM_REC);
167     BEGIN
168          PROC4 (0);
169          IF GLOBAL_INT = IDENT_INT (0) THEN
170               FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
171               DELAY 35.0 * Impdef.One_Second;
172          END IF;
173     END;
174
175     -------------------------------------------------------------------
176     GLOBAL_INT := IDENT_INT (0);
177
178     DECLARE
179          A : INTEGER;
180          FUNCTION FUNC1 IS NEW FUNC (TT);
181     BEGIN
182          A := FUNC1 (1);
183          FAILED ("EXCEPTION NOT RAISED - 5");
184     EXCEPTION
185          WHEN MY_EXCEPTION =>
186               IF GLOBAL_INT = IDENT_INT (0) THEN
187                    FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
188                    DELAY 35.0 * Impdef.One_Second;
189               END IF;
190          WHEN OTHERS =>
191               FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
192     END;
193
194     -------------------------------------------------------------------
195     GLOBAL_INT := IDENT_INT (0);
196
197     DECLARE
198          A : INTEGER;
199          FUNCTION FUNC2 IS NEW FUNC (REC);
200     BEGIN
201          A := FUNC2 (0);
202          IF GLOBAL_INT = IDENT_INT (0) THEN
203               FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
204               DELAY 35.0 * Impdef.One_Second;
205          END IF;
206     END;
207
208     -------------------------------------------------------------------
209     GLOBAL_INT := IDENT_INT (0);
210
211     DECLARE
212          A : INTEGER;
213          FUNCTION FUNC3 IS NEW FUNC (LIM_PRI_TASK);
214     BEGIN
215          A := FUNC3 (0);
216          IF GLOBAL_INT = IDENT_INT (0) THEN
217               FAILED ("TASK NOT DEPENDENT ON MASTER - 7");
218               DELAY 35.0 * Impdef.One_Second;
219          END IF;
220     END;
221
222     -------------------------------------------------------------------
223     GLOBAL_INT := IDENT_INT (0);
224
225     DECLARE
226          A : INTEGER;
227          FUNCTION FUNC4 IS NEW FUNC (LIM_REC);
228     BEGIN
229          A := FUNC4 (1);
230          FAILED ("EXCEPTION NOT RAISED - 8");
231     EXCEPTION
232          WHEN MY_EXCEPTION =>
233               IF GLOBAL_INT = IDENT_INT (0) THEN
234                    FAILED ("TASK NOT DEPENDENT ON MASTER - 8");
235               END IF;
236          WHEN OTHERS =>
237               FAILED ("UNEXPECTED EXCEPTION RAISED - 8");
238     END;
239
240     -------------------------------------------------------------------
241
242     RESULT;
243END C94010A;
244