1-- C94005B.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 TASK TYPE IS DECLARED IN A LIBRARY PACKAGE, ANY
26--   BLOCKS, SUBPROGRAMS, OR TASKS THAT DECLARE OBJECTS OF THAT TYPE
27--   DO WAIT FOR TERMINATION OF SUCH OBJECTS.
28-- SUBTESTS ARE:
29--   (A)  IN A MAIN PROGRAM BLOCK.
30--   (B)  IN A LIBRARY FUNCTION.
31--   (C)  IN A MAIN PROGRAM TASK BODY.
32
33-- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
34
35-- JRK 10/8/81
36-- SPS 11/2/82
37-- SPS 11/21/82
38-- JWC 11/15/85    MADE THE LIBRARY PACKAGE NAME UNIQUE, C94005B_PKG.
39-- PWN 01/31/95    REMOVED PRAGMA PRIORITY FOR ADA 9X.
40
41
42WITH SYSTEM; USE SYSTEM;
43PACKAGE C94005B_PKG IS
44
45     GLOBAL : INTEGER;
46
47     TASK TYPE TT IS
48          ENTRY E (I : INTEGER);
49     END TT;
50
51END C94005B_PKG;
52
53with Impdef;
54PACKAGE BODY C94005B_PKG IS
55
56     TASK BODY TT IS
57          LOCAL : INTEGER;
58     BEGIN
59          ACCEPT E (I : INTEGER) DO
60               LOCAL := I;
61          END E;
62          DELAY 60.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
63                         -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
64                         -- TERMINATE IF THE ERROR IS PRESENT.
65          GLOBAL := LOCAL;
66     END TT;
67
68END C94005B_PKG;
69
70
71WITH REPORT; USE REPORT;
72WITH C94005B_PKG; USE C94005B_PKG;
73FUNCTION F RETURN INTEGER IS
74
75     T : TT;
76
77BEGIN
78
79     T.E (IDENT_INT(2));
80     RETURN 0;
81
82END F;
83
84with Impdef;
85WITH SYSTEM; USE SYSTEM;
86WITH REPORT; USE REPORT;
87WITH C94005B_PKG; USE C94005B_PKG;
88WITH F;
89PROCEDURE C94005B IS
90
91
92BEGIN
93     TEST ("C94005B", "CHECK THAT IF A TASK TYPE IS DECLARED IN A " &
94                      "LIBRARY PACKAGE, ANY BLOCKS, SUBPROGRAMS, OR " &
95                      "TASKS THAT DECLARE OBJECTS OF THAT TYPE DO " &
96                      "WAIT FOR TERMINATION OF SUCH OBJECTS");
97
98     --------------------------------------------------
99
100     GLOBAL := IDENT_INT (0);
101
102     DECLARE -- (A)
103
104          T : TT;
105
106     BEGIN -- (A)
107
108          T.E (IDENT_INT(1));
109
110     END; -- (A)
111
112     IF GLOBAL /= 1 THEN
113          FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
114                  "BLOCK EXIT - (A)");
115     END IF;
116
117     --------------------------------------------------
118
119     GLOBAL := IDENT_INT (0);
120
121     DECLARE -- (B)
122
123          I : INTEGER;
124
125     BEGIN -- (B)
126
127          I := F ;
128
129          IF GLOBAL /= 2 THEN
130               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
131                       "FUNCTION EXIT - (B)");
132          END IF;
133
134     END; -- (B)
135
136     --------------------------------------------------
137
138     GLOBAL := IDENT_INT (0);
139
140     DECLARE -- (C)
141
142          TASK TSK IS
143               ENTRY ENT;
144          END TSK;
145
146          TASK BODY TSK IS
147               T : TT;
148          BEGIN
149               T.E (IDENT_INT(3));
150          END TSK;
151
152     BEGIN -- (C)
153
154          WHILE NOT TSK'TERMINATED LOOP
155               DELAY 0.1 * Impdef.One_Second;
156          END LOOP;
157
158          IF GLOBAL /= 3 THEN
159               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
160                       "TASK EXIT - (C)");
161          END IF;
162
163     END; -- (C)
164
165     --------------------------------------------------
166
167     RESULT;
168END C94005B;
169