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
36with Impdef;
37WITH REPORT; USE REPORT;
38WITH SYSTEM; USE SYSTEM;
39PROCEDURE 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
161BEGIN -- 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;
265END C94008C;
266