3 -- Grant of Unlimited Rights
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
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.
25 -- CHECK THAT SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
28 -- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
31 -- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
33 -- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
34 -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
37 WITH REPORT
; USE REPORT
;
38 WITH SYSTEM
; USE SYSTEM
;
42 -- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
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 <>;
52 PROCEDURE SET
(VALUE
: IN HOLDER_TYPE
);
53 PROCEDURE UPDATE
(VALUE
: IN VALUE_TYPE
);
54 FUNCTION GET
RETURN HOLDER_TYPE
;
57 PACKAGE BODY SHARED
IS
59 ENTRY SET
(VALUE
: IN HOLDER_TYPE
);
60 ENTRY UPDATE
(VALUE
: IN VALUE_TYPE
);
61 ENTRY READ
(VALUE
: OUT HOLDER_TYPE
);
65 VARIABLE
: HOLDER_TYPE
;
69 ACCEPT SET
(VALUE
: IN HOLDER_TYPE
) DO
70 SHARED
.SET
(VARIABLE
, VALUE
);
73 ACCEPT UPDATE
(VALUE
: IN VALUE_TYPE
) DO
74 SHARED
.UPDATE
(VARIABLE
, VALUE
);
77 ACCEPT READ
(VALUE
: OUT HOLDER_TYPE
) DO
86 PROCEDURE SET
(VALUE
: IN HOLDER_TYPE
) IS
91 PROCEDURE UPDATE
(VALUE
: IN VALUE_TYPE
) IS
96 FUNCTION GET
RETURN HOLDER_TYPE
IS
104 SHARE
.SET
(INITIAL_VALUE
); -- SET INITIAL VALUE
111 TRACE
: STRING (1..4) := "....";
112 LENGTH
: NATURAL := 0;
115 PROCEDURE UPDATE
(VAR
: IN OUT EVENT_TYPE
; VAL
: CHARACTER);
116 PROCEDURE SET
(VAR
: OUT EVENT_TYPE
; VAL
: EVENT_TYPE
);
120 PROCEDURE UPDATE
(VAR
: IN OUT INTEGER; VAL
: INTEGER);
121 PROCEDURE SET
(VAR
: OUT INTEGER; VAL
: INTEGER);
124 PACKAGE BODY COUNTER
IS
125 PROCEDURE UPDATE
(VAR
: IN OUT INTEGER; VAL
: INTEGER) IS
130 PROCEDURE SET
(VAR
: OUT INTEGER; VAL
: INTEGER) IS
136 PACKAGE BODY EVENTS
IS
137 PROCEDURE UPDATE
(VAR
: IN OUT EVENT_TYPE
; VAL
: CHARACTER) IS
139 VAR
.LENGTH
:= VAR
.LENGTH
+ 1;
140 VAR
.TRACE
(VAR
.LENGTH
) := VAL
;
143 PROCEDURE SET
(VAR
: OUT EVENT_TYPE
; VAL
: EVENT_TYPE
) IS
152 PACKAGE TRACE
IS NEW SHARED
(EVENT_TYPE
, CHARACTER, ("....", 0));
153 PACKAGE TERMINATE_COUNT
IS NEW SHARED
(INTEGER, INTEGER, 0);
155 FUNCTION ENTER_TERMINATE
RETURN BOOLEAN IS
157 TERMINATE_COUNT
.UPDATE
(1);
163 TEST
("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
164 "TERMINATE ALTERNATIVE");
168 PROCEDURE EVENT
(VAR
: CHARACTER) RENAMES TRACE
.UPDATE
;
190 OR WHEN ENTER_TERMINATE
=> TERMINATE;
199 OR WHEN ENTER_TERMINATE
=> TERMINATE;
202 DELAY 10.0 * Impdef
.One_Second
;
204 IF TERMINATE_COUNT
.GET
/= 1 THEN
205 DELAY 20.0 * Impdef
.One_Second
;
208 IF TERMINATE_COUNT
.GET
/= 1 THEN
209 FAILED
("30 SECOND DELAY NOT ENOUGH - 1 ");
221 OR WHEN ENTER_TERMINATE
=> TERMINATE;
225 TERMINATE_COUNT
.SET
(0);
230 OR WHEN ENTER_TERMINATE
=> TERMINATE;
235 OR TERMINATE; -- ONLY THIS ONE EVER CHOSEN.
238 FAILED
("TERMINATE NOT SELECTED IN T1");
243 DELAY 10.0 * Impdef
.One_Second
; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
245 IF TERMINATE_COUNT
.GET
/= 3 THEN
246 DELAY 20.0 * Impdef
.One_Second
;
249 IF TERMINATE_COUNT
.GET
/= 3 THEN
250 FAILED
("30 SECOND DELAY NOT ENOUGH - 2");
257 WHEN OTHERS => FAILED
("EXCEPTION IN MAIN BLOCK");
260 IF TRACE
.GET
.TRACE
/= "ABCD" THEN
261 FAILED
("INCORRECT ORDER OF EVENTS: " & TRACE
.GET
.TRACE
);