|
111
|
1 -- C94008C.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 SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
|
|
|
26 -- NESTED TASKS.
|
|
|
27
|
|
|
28 -- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
|
|
|
29 -- CONTAINS TASKS.
|
|
|
30
|
|
|
31 -- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
|
|
|
32 -- JRK 4/7/86
|
|
|
33 -- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
|
|
|
34 -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
|
|
|
35
|
|
|
36 with Impdef;
|
|
|
37 WITH REPORT; USE REPORT;
|
|
|
38 WITH SYSTEM; USE SYSTEM;
|
|
|
39 PROCEDURE C94008C IS
|
|
|
40
|
|
|
41
|
|
|
42 -- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
|
|
|
43 GENERIC
|
|
|
44 TYPE HOLDER_TYPE IS PRIVATE;
|
|
|
45 TYPE VALUE_TYPE IS PRIVATE;
|
|
|
46 INITIAL_VALUE : HOLDER_TYPE;
|
|
|
47 WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
|
|
|
48 VALUE : IN HOLDER_TYPE) IS <>;
|
|
|
49 WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
|
|
|
50 VALUE : IN VALUE_TYPE) IS <>;
|
|
|
51 PACKAGE SHARED IS
|
|
|
52 PROCEDURE SET (VALUE : IN HOLDER_TYPE);
|
|
|
53 PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
|
|
|
54 FUNCTION GET RETURN HOLDER_TYPE;
|
|
|
55 END SHARED;
|
|
|
56
|
|
|
57 PACKAGE BODY SHARED IS
|
|
|
58 TASK SHARE IS
|
|
|
59 ENTRY SET (VALUE : IN HOLDER_TYPE);
|
|
|
60 ENTRY UPDATE (VALUE : IN VALUE_TYPE);
|
|
|
61 ENTRY READ (VALUE : OUT HOLDER_TYPE);
|
|
|
62 END SHARE;
|
|
|
63
|
|
|
64 TASK BODY SHARE IS
|
|
|
65 VARIABLE : HOLDER_TYPE;
|
|
|
66 BEGIN
|
|
|
67 LOOP
|
|
|
68 SELECT
|
|
|
69 ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
|
|
|
70 SHARED.SET (VARIABLE, VALUE);
|
|
|
71 END SET;
|
|
|
72 OR
|
|
|
73 ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
|
|
|
74 SHARED.UPDATE (VARIABLE, VALUE);
|
|
|
75 END UPDATE;
|
|
|
76 OR
|
|
|
77 ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
|
|
|
78 VALUE := VARIABLE;
|
|
|
79 END READ;
|
|
|
80 OR
|
|
|
81 TERMINATE;
|
|
|
82 END SELECT;
|
|
|
83 END LOOP;
|
|
|
84 END SHARE;
|
|
|
85
|
|
|
86 PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
|
|
|
87 BEGIN
|
|
|
88 SHARE.SET (VALUE);
|
|
|
89 END SET;
|
|
|
90
|
|
|
91 PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
|
|
|
92 BEGIN
|
|
|
93 SHARE.UPDATE (VALUE);
|
|
|
94 END UPDATE;
|
|
|
95
|
|
|
96 FUNCTION GET RETURN HOLDER_TYPE IS
|
|
|
97 VALUE : HOLDER_TYPE;
|
|
|
98 BEGIN
|
|
|
99 SHARE.READ (VALUE);
|
|
|
100 RETURN VALUE;
|
|
|
101 END GET;
|
|
|
102
|
|
|
103 BEGIN
|
|
|
104 SHARE.SET (INITIAL_VALUE); -- SET INITIAL VALUE
|
|
|
105 END SHARED;
|
|
|
106
|
|
|
107 PACKAGE EVENTS IS
|
|
|
108
|
|
|
109 TYPE EVENT_TYPE IS
|
|
|
110 RECORD
|
|
|
111 TRACE : STRING (1..4) := "....";
|
|
|
112 LENGTH : NATURAL := 0;
|
|
|
113 END RECORD;
|
|
|
114
|
|
|
115 PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
|
|
|
116 PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
|
|
|
117 END EVENTS;
|
|
|
118
|
|
|
119 PACKAGE COUNTER IS
|
|
|
120 PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
|
|
|
121 PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
|
|
|
122 END COUNTER;
|
|
|
123
|
|
|
124 PACKAGE BODY COUNTER IS
|
|
|
125 PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
|
|
|
126 BEGIN
|
|
|
127 VAR := VAR + VAL;
|
|
|
128 END UPDATE;
|
|
|
129
|
|
|
130 PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
|
|
|
131 BEGIN
|
|
|
132 VAR := VAL;
|
|
|
133 END SET;
|
|
|
134 END COUNTER;
|
|
|
135
|
|
|
136 PACKAGE BODY EVENTS IS
|
|
|
137 PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
|
|
|
138 BEGIN
|
|
|
139 VAR.LENGTH := VAR.LENGTH + 1;
|
|
|
140 VAR.TRACE(VAR.LENGTH) := VAL;
|
|
|
141 END UPDATE;
|
|
|
142
|
|
|
143 PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
|
|
|
144 BEGIN
|
|
|
145 VAR := VAL;
|
|
|
146 END SET;
|
|
|
147
|
|
|
148 END EVENTS;
|
|
|
149
|
|
|
150 USE EVENTS, COUNTER;
|
|
|
151
|
|
|
152 PACKAGE TRACE IS NEW SHARED (EVENT_TYPE, CHARACTER, ("....", 0));
|
|
|
153 PACKAGE TERMINATE_COUNT IS NEW SHARED (INTEGER, INTEGER, 0);
|
|
|
154
|
|
|
155 FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
|
|
|
156 BEGIN
|
|
|
157 TERMINATE_COUNT.UPDATE (1);
|
|
|
158 RETURN TRUE;
|
|
|
159 END ENTER_TERMINATE;
|
|
|
160
|
|
|
161 BEGIN -- C94008C
|
|
|
162
|
|
|
163 TEST ("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
|
|
|
164 "TERMINATE ALTERNATIVE");
|
|
|
165
|
|
|
166 DECLARE
|
|
|
167
|
|
|
168 PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
|
|
|
169
|
|
|
170 TASK T1 IS
|
|
|
171 ENTRY E1;
|
|
|
172 END T1;
|
|
|
173
|
|
|
174 TASK BODY T1 IS
|
|
|
175
|
|
|
176 TASK T2 IS
|
|
|
177 ENTRY E2;
|
|
|
178 END T2;
|
|
|
179
|
|
|
180 TASK BODY T2 IS
|
|
|
181
|
|
|
182 TASK T3 IS
|
|
|
183 ENTRY E3;
|
|
|
184 END T3;
|
|
|
185
|
|
|
186 TASK BODY T3 IS
|
|
|
187 BEGIN
|
|
|
188 SELECT
|
|
|
189 ACCEPT E3;
|
|
|
190 OR WHEN ENTER_TERMINATE => TERMINATE;
|
|
|
191 END SELECT;
|
|
|
192 EVENT ('D');
|
|
|
193 END T3;
|
|
|
194
|
|
|
195 BEGIN -- T2
|
|
|
196
|
|
|
197 SELECT
|
|
|
198 ACCEPT E2;
|
|
|
199 OR WHEN ENTER_TERMINATE => TERMINATE;
|
|
|
200 END SELECT;
|
|
|
201
|
|
|
202 DELAY 10.0 * Impdef.One_Second;
|
|
|
203
|
|
|
204 IF TERMINATE_COUNT.GET /= 1 THEN
|
|
|
205 DELAY 20.0 * Impdef.One_Long_Second;
|
|
|
206 END IF;
|
|
|
207
|
|
|
208 IF TERMINATE_COUNT.GET /= 1 THEN
|
|
|
209 FAILED ("30 SECOND DELAY NOT ENOUGH - 1 ");
|
|
|
210 END IF;
|
|
|
211
|
|
|
212 EVENT ('C');
|
|
|
213 T1.E1;
|
|
|
214 T3.E3;
|
|
|
215 END T2;
|
|
|
216
|
|
|
217 BEGIN -- T1;
|
|
|
218
|
|
|
219 SELECT
|
|
|
220 ACCEPT E1;
|
|
|
221 OR WHEN ENTER_TERMINATE => TERMINATE;
|
|
|
222 END SELECT;
|
|
|
223
|
|
|
224 EVENT ('B');
|
|
|
225 TERMINATE_COUNT.SET (0);
|
|
|
226 T2.E2;
|
|
|
227
|
|
|
228 SELECT
|
|
|
229 ACCEPT E1;
|
|
|
230 OR WHEN ENTER_TERMINATE => TERMINATE;
|
|
|
231 END SELECT;
|
|
|
232
|
|
|
233 SELECT
|
|
|
234 ACCEPT E1;
|
|
|
235 OR TERMINATE; -- ONLY THIS ONE EVER CHOSEN.
|
|
|
236 END SELECT;
|
|
|
237
|
|
|
238 FAILED ("TERMINATE NOT SELECTED IN T1");
|
|
|
239 END T1;
|
|
|
240
|
|
|
241 BEGIN
|
|
|
242
|
|
|
243 DELAY 10.0 * Impdef.One_Second; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
|
|
|
244
|
|
|
245 IF TERMINATE_COUNT.GET /= 3 THEN
|
|
|
246 DELAY 20.0 * Impdef.One_Long_Second;
|
|
|
247 END IF;
|
|
|
248
|
|
|
249 IF TERMINATE_COUNT.GET /= 3 THEN
|
|
|
250 FAILED ("30 SECOND DELAY NOT ENOUGH - 2");
|
|
|
251 END IF;
|
|
|
252
|
|
|
253 EVENT ('A');
|
|
|
254 T1.E1;
|
|
|
255
|
|
|
256 EXCEPTION
|
|
|
257 WHEN OTHERS => FAILED ("EXCEPTION IN MAIN BLOCK");
|
|
|
258 END;
|
|
|
259
|
|
|
260 IF TRACE.GET.TRACE /= "ABCD" THEN
|
|
|
261 FAILED ("INCORRECT ORDER OF EVENTS: " & TRACE.GET.TRACE);
|
|
|
262 END IF;
|
|
|
263
|
|
|
264 RESULT;
|
|
|
265 END C94008C;
|
