-- C94008C.ADA
|
-- C94008C.ADA
|
|
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
-- CHECK THAT SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
|
-- CHECK THAT SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
|
-- NESTED TASKS.
|
-- NESTED TASKS.
|
|
|
-- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
|
-- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
|
-- CONTAINS TASKS.
|
-- CONTAINS TASKS.
|
|
|
-- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
|
-- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
|
-- JRK 4/7/86
|
-- JRK 4/7/86
|
-- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
|
-- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
|
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
|
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
|
|
|
with Impdef;
|
with Impdef;
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
WITH SYSTEM; USE SYSTEM;
|
WITH SYSTEM; USE SYSTEM;
|
PROCEDURE C94008C IS
|
PROCEDURE C94008C IS
|
|
|
|
|
-- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
|
-- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
|
GENERIC
|
GENERIC
|
TYPE HOLDER_TYPE IS PRIVATE;
|
TYPE HOLDER_TYPE IS PRIVATE;
|
TYPE VALUE_TYPE IS PRIVATE;
|
TYPE VALUE_TYPE IS PRIVATE;
|
INITIAL_VALUE : HOLDER_TYPE;
|
INITIAL_VALUE : HOLDER_TYPE;
|
WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
|
WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
|
VALUE : IN HOLDER_TYPE) IS <>;
|
VALUE : IN HOLDER_TYPE) IS <>;
|
WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
|
WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
|
VALUE : IN VALUE_TYPE) IS <>;
|
VALUE : IN VALUE_TYPE) IS <>;
|
PACKAGE SHARED IS
|
PACKAGE SHARED IS
|
PROCEDURE SET (VALUE : IN HOLDER_TYPE);
|
PROCEDURE SET (VALUE : IN HOLDER_TYPE);
|
PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
|
PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
|
FUNCTION GET RETURN HOLDER_TYPE;
|
FUNCTION GET RETURN HOLDER_TYPE;
|
END SHARED;
|
END SHARED;
|
|
|
PACKAGE BODY SHARED IS
|
PACKAGE BODY SHARED IS
|
TASK SHARE IS
|
TASK SHARE IS
|
ENTRY SET (VALUE : IN HOLDER_TYPE);
|
ENTRY SET (VALUE : IN HOLDER_TYPE);
|
ENTRY UPDATE (VALUE : IN VALUE_TYPE);
|
ENTRY UPDATE (VALUE : IN VALUE_TYPE);
|
ENTRY READ (VALUE : OUT HOLDER_TYPE);
|
ENTRY READ (VALUE : OUT HOLDER_TYPE);
|
END SHARE;
|
END SHARE;
|
|
|
TASK BODY SHARE IS
|
TASK BODY SHARE IS
|
VARIABLE : HOLDER_TYPE;
|
VARIABLE : HOLDER_TYPE;
|
BEGIN
|
BEGIN
|
LOOP
|
LOOP
|
SELECT
|
SELECT
|
ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
|
ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
|
SHARED.SET (VARIABLE, VALUE);
|
SHARED.SET (VARIABLE, VALUE);
|
END SET;
|
END SET;
|
OR
|
OR
|
ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
|
ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
|
SHARED.UPDATE (VARIABLE, VALUE);
|
SHARED.UPDATE (VARIABLE, VALUE);
|
END UPDATE;
|
END UPDATE;
|
OR
|
OR
|
ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
|
ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
|
VALUE := VARIABLE;
|
VALUE := VARIABLE;
|
END READ;
|
END READ;
|
OR
|
OR
|
TERMINATE;
|
TERMINATE;
|
END SELECT;
|
END SELECT;
|
END LOOP;
|
END LOOP;
|
END SHARE;
|
END SHARE;
|
|
|
PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
|
PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
|
BEGIN
|
BEGIN
|
SHARE.SET (VALUE);
|
SHARE.SET (VALUE);
|
END SET;
|
END SET;
|
|
|
PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
|
PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
|
BEGIN
|
BEGIN
|
SHARE.UPDATE (VALUE);
|
SHARE.UPDATE (VALUE);
|
END UPDATE;
|
END UPDATE;
|
|
|
FUNCTION GET RETURN HOLDER_TYPE IS
|
FUNCTION GET RETURN HOLDER_TYPE IS
|
VALUE : HOLDER_TYPE;
|
VALUE : HOLDER_TYPE;
|
BEGIN
|
BEGIN
|
SHARE.READ (VALUE);
|
SHARE.READ (VALUE);
|
RETURN VALUE;
|
RETURN VALUE;
|
END GET;
|
END GET;
|
|
|
BEGIN
|
BEGIN
|
SHARE.SET (INITIAL_VALUE); -- SET INITIAL VALUE
|
SHARE.SET (INITIAL_VALUE); -- SET INITIAL VALUE
|
END SHARED;
|
END SHARED;
|
|
|
PACKAGE EVENTS IS
|
PACKAGE EVENTS IS
|
|
|
TYPE EVENT_TYPE IS
|
TYPE EVENT_TYPE IS
|
RECORD
|
RECORD
|
TRACE : STRING (1..4) := "....";
|
TRACE : STRING (1..4) := "....";
|
LENGTH : NATURAL := 0;
|
LENGTH : NATURAL := 0;
|
END RECORD;
|
END RECORD;
|
|
|
PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
|
PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
|
PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
|
PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
|
END EVENTS;
|
END EVENTS;
|
|
|
PACKAGE COUNTER IS
|
PACKAGE COUNTER IS
|
PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
|
PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
|
PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
|
PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
|
END COUNTER;
|
END COUNTER;
|
|
|
PACKAGE BODY COUNTER IS
|
PACKAGE BODY COUNTER IS
|
PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
|
PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
|
BEGIN
|
BEGIN
|
VAR := VAR + VAL;
|
VAR := VAR + VAL;
|
END UPDATE;
|
END UPDATE;
|
|
|
PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
|
PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
|
BEGIN
|
BEGIN
|
VAR := VAL;
|
VAR := VAL;
|
END SET;
|
END SET;
|
END COUNTER;
|
END COUNTER;
|
|
|
PACKAGE BODY EVENTS IS
|
PACKAGE BODY EVENTS IS
|
PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
|
PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
|
BEGIN
|
BEGIN
|
VAR.LENGTH := VAR.LENGTH + 1;
|
VAR.LENGTH := VAR.LENGTH + 1;
|
VAR.TRACE(VAR.LENGTH) := VAL;
|
VAR.TRACE(VAR.LENGTH) := VAL;
|
END UPDATE;
|
END UPDATE;
|
|
|
PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
|
PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
|
BEGIN
|
BEGIN
|
VAR := VAL;
|
VAR := VAL;
|
END SET;
|
END SET;
|
|
|
END EVENTS;
|
END EVENTS;
|
|
|
USE EVENTS, COUNTER;
|
USE EVENTS, COUNTER;
|
|
|
PACKAGE TRACE IS NEW SHARED (EVENT_TYPE, CHARACTER, ("....", 0));
|
PACKAGE TRACE IS NEW SHARED (EVENT_TYPE, CHARACTER, ("....", 0));
|
PACKAGE TERMINATE_COUNT IS NEW SHARED (INTEGER, INTEGER, 0);
|
PACKAGE TERMINATE_COUNT IS NEW SHARED (INTEGER, INTEGER, 0);
|
|
|
FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
|
FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
|
BEGIN
|
BEGIN
|
TERMINATE_COUNT.UPDATE (1);
|
TERMINATE_COUNT.UPDATE (1);
|
RETURN TRUE;
|
RETURN TRUE;
|
END ENTER_TERMINATE;
|
END ENTER_TERMINATE;
|
|
|
BEGIN -- C94008C
|
BEGIN -- C94008C
|
|
|
TEST ("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
|
TEST ("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
|
"TERMINATE ALTERNATIVE");
|
"TERMINATE ALTERNATIVE");
|
|
|
DECLARE
|
DECLARE
|
|
|
PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
|
PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
|
|
|
TASK T1 IS
|
TASK T1 IS
|
ENTRY E1;
|
ENTRY E1;
|
END T1;
|
END T1;
|
|
|
TASK BODY T1 IS
|
TASK BODY T1 IS
|
|
|
TASK T2 IS
|
TASK T2 IS
|
ENTRY E2;
|
ENTRY E2;
|
END T2;
|
END T2;
|
|
|
TASK BODY T2 IS
|
TASK BODY T2 IS
|
|
|
TASK T3 IS
|
TASK T3 IS
|
ENTRY E3;
|
ENTRY E3;
|
END T3;
|
END T3;
|
|
|
TASK BODY T3 IS
|
TASK BODY T3 IS
|
BEGIN
|
BEGIN
|
SELECT
|
SELECT
|
ACCEPT E3;
|
ACCEPT E3;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
END SELECT;
|
END SELECT;
|
EVENT ('D');
|
EVENT ('D');
|
END T3;
|
END T3;
|
|
|
BEGIN -- T2
|
BEGIN -- T2
|
|
|
SELECT
|
SELECT
|
ACCEPT E2;
|
ACCEPT E2;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
END SELECT;
|
END SELECT;
|
|
|
DELAY 10.0 * Impdef.One_Second;
|
DELAY 10.0 * Impdef.One_Second;
|
|
|
IF TERMINATE_COUNT.GET /= 1 THEN
|
IF TERMINATE_COUNT.GET /= 1 THEN
|
DELAY 20.0 * Impdef.One_Second;
|
DELAY 20.0 * Impdef.One_Second;
|
END IF;
|
END IF;
|
|
|
IF TERMINATE_COUNT.GET /= 1 THEN
|
IF TERMINATE_COUNT.GET /= 1 THEN
|
FAILED ("30 SECOND DELAY NOT ENOUGH - 1 ");
|
FAILED ("30 SECOND DELAY NOT ENOUGH - 1 ");
|
END IF;
|
END IF;
|
|
|
EVENT ('C');
|
EVENT ('C');
|
T1.E1;
|
T1.E1;
|
T3.E3;
|
T3.E3;
|
END T2;
|
END T2;
|
|
|
BEGIN -- T1;
|
BEGIN -- T1;
|
|
|
SELECT
|
SELECT
|
ACCEPT E1;
|
ACCEPT E1;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
END SELECT;
|
END SELECT;
|
|
|
EVENT ('B');
|
EVENT ('B');
|
TERMINATE_COUNT.SET (0);
|
TERMINATE_COUNT.SET (0);
|
T2.E2;
|
T2.E2;
|
|
|
SELECT
|
SELECT
|
ACCEPT E1;
|
ACCEPT E1;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
END SELECT;
|
END SELECT;
|
|
|
SELECT
|
SELECT
|
ACCEPT E1;
|
ACCEPT E1;
|
OR TERMINATE; -- ONLY THIS ONE EVER CHOSEN.
|
OR TERMINATE; -- ONLY THIS ONE EVER CHOSEN.
|
END SELECT;
|
END SELECT;
|
|
|
FAILED ("TERMINATE NOT SELECTED IN T1");
|
FAILED ("TERMINATE NOT SELECTED IN T1");
|
END T1;
|
END T1;
|
|
|
BEGIN
|
BEGIN
|
|
|
DELAY 10.0 * Impdef.One_Second; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
|
DELAY 10.0 * Impdef.One_Second; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
|
|
|
IF TERMINATE_COUNT.GET /= 3 THEN
|
IF TERMINATE_COUNT.GET /= 3 THEN
|
DELAY 20.0 * Impdef.One_Second;
|
DELAY 20.0 * Impdef.One_Second;
|
END IF;
|
END IF;
|
|
|
IF TERMINATE_COUNT.GET /= 3 THEN
|
IF TERMINATE_COUNT.GET /= 3 THEN
|
FAILED ("30 SECOND DELAY NOT ENOUGH - 2");
|
FAILED ("30 SECOND DELAY NOT ENOUGH - 2");
|
END IF;
|
END IF;
|
|
|
EVENT ('A');
|
EVENT ('A');
|
T1.E1;
|
T1.E1;
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS => FAILED ("EXCEPTION IN MAIN BLOCK");
|
WHEN OTHERS => FAILED ("EXCEPTION IN MAIN BLOCK");
|
END;
|
END;
|
|
|
IF TRACE.GET.TRACE /= "ABCD" THEN
|
IF TRACE.GET.TRACE /= "ABCD" THEN
|
FAILED ("INCORRECT ORDER OF EVENTS: " & TRACE.GET.TRACE);
|
FAILED ("INCORRECT ORDER OF EVENTS: " & TRACE.GET.TRACE);
|
END IF;
|
END IF;
|
|
|
RESULT;
|
RESULT;
|
END C94008C;
|
END C94008C;
|
|
|