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