-- C94008D.ADA
|
-- C94008D.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 CORRECT OPERATION OF SELECT WITH TERMINATE ALTERNATIVE WHEN
|
-- CHECK CORRECT OPERATION OF SELECT WITH TERMINATE ALTERNATIVE WHEN
|
-- EXECUTED FROM AN INNER BLOCK WITH OUTER DEPENDING TASKS.
|
-- EXECUTED FROM AN INNER BLOCK WITH OUTER DEPENDING TASKS.
|
|
|
-- JEAN-PIERRE ROSEN 03-MAR-84
|
-- JEAN-PIERRE ROSEN 03-MAR-84
|
-- JRK 4/7/86
|
-- JRK 4/7/86
|
-- JBG 9/4/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT/SUBUNIT
|
-- JBG 9/4/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT/SUBUNIT
|
-- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X.
|
-- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X.
|
|
|
-- 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_C94008D IS
|
PACKAGE SHARED_C94008D 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_C94008D;
|
END SHARED_C94008D;
|
|
|
PACKAGE BODY SHARED_C94008D IS
|
PACKAGE BODY SHARED_C94008D 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 SEPARATE;
|
TASK BODY SHARE IS SEPARATE;
|
|
|
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_C94008D;
|
END SHARED_C94008D;
|
|
|
PACKAGE EVENTS_C94008D IS
|
PACKAGE EVENTS_C94008D 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_C94008D;
|
END EVENTS_C94008D;
|
|
|
PACKAGE COUNTER_C94008D IS
|
PACKAGE COUNTER_C94008D 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_C94008D;
|
END COUNTER_C94008D;
|
|
|
PACKAGE BODY COUNTER_C94008D IS
|
PACKAGE BODY COUNTER_C94008D 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_C94008D;
|
END COUNTER_C94008D;
|
|
|
PACKAGE BODY EVENTS_C94008D IS
|
PACKAGE BODY EVENTS_C94008D 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_C94008D;
|
END EVENTS_C94008D;
|
|
|
SEPARATE (SHARED_C94008D)
|
SEPARATE (SHARED_C94008D)
|
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_C94008D.SET (VARIABLE, VALUE);
|
SHARED_C94008D.SET (VARIABLE, VALUE);
|
END SET;
|
END SET;
|
OR
|
OR
|
ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
|
ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
|
SHARED_C94008D.UPDATE (VARIABLE, VALUE);
|
SHARED_C94008D.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;
|
|
|
with Impdef;
|
with Impdef;
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
WITH SYSTEM; USE SYSTEM;
|
WITH SYSTEM; USE SYSTEM;
|
WITH SHARED_C94008D, COUNTER_C94008D, EVENTS_C94008D;
|
WITH SHARED_C94008D, COUNTER_C94008D, EVENTS_C94008D;
|
USE COUNTER_C94008D, EVENTS_C94008D;
|
USE COUNTER_C94008D, EVENTS_C94008D;
|
PROCEDURE C94008D IS
|
PROCEDURE C94008D IS
|
|
|
PACKAGE TRACE IS
|
PACKAGE TRACE IS
|
NEW SHARED_C94008D (EVENT_TYPE, CHARACTER, ("....", 0));
|
NEW SHARED_C94008D (EVENT_TYPE, CHARACTER, ("....", 0));
|
PACKAGE TERMINATE_COUNT IS
|
PACKAGE TERMINATE_COUNT IS
|
NEW SHARED_C94008D (INTEGER, INTEGER, 0);
|
NEW SHARED_C94008D (INTEGER, INTEGER, 0);
|
|
|
PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
|
PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
|
|
|
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
|
BEGIN
|
TEST ("C94008D", "CHECK CORRECT OPERATION OF SELECT WITH " &
|
TEST ("C94008D", "CHECK CORRECT OPERATION OF SELECT WITH " &
|
"TERMINATE ALTERNATIVE FROM AN INNER BLOCK");
|
"TERMINATE ALTERNATIVE FROM AN INNER BLOCK");
|
|
|
DECLARE
|
DECLARE
|
|
|
TASK T1 IS
|
TASK T1 IS
|
ENTRY E1;
|
ENTRY E1;
|
END T1;
|
END T1;
|
|
|
TASK BODY T1 IS
|
TASK BODY T1 IS
|
BEGIN
|
BEGIN
|
DECLARE
|
DECLARE
|
|
|
TASK T2 IS
|
TASK T2 IS
|
ENTRY E2;
|
ENTRY E2;
|
END T2;
|
END T2;
|
|
|
TASK BODY T2 IS
|
TASK BODY T2 IS
|
BEGIN
|
BEGIN
|
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");
|
FAILED ("30 SECOND DELAY NOT ENOUGH");
|
END IF;
|
END IF;
|
|
|
IF T1'TERMINATED OR NOT T1'CALLABLE THEN
|
IF T1'TERMINATED OR NOT T1'CALLABLE THEN
|
FAILED ("T1 PREMATURELY TERMINATED");
|
FAILED ("T1 PREMATURELY TERMINATED");
|
END IF;
|
END IF;
|
|
|
EVENT ('A');
|
EVENT ('A');
|
|
|
SELECT
|
SELECT
|
ACCEPT E2;
|
ACCEPT E2;
|
OR TERMINATE;
|
OR TERMINATE;
|
END SELECT;
|
END SELECT;
|
|
|
FAILED ("TERMINATE NOT SELECTED IN T2");
|
FAILED ("TERMINATE NOT SELECTED IN T2");
|
END T2;
|
END T2;
|
|
|
BEGIN
|
BEGIN
|
BEGIN
|
BEGIN
|
EVENT ('B');
|
EVENT ('B');
|
|
|
SELECT
|
SELECT
|
ACCEPT E1;
|
ACCEPT E1;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
OR WHEN ENTER_TERMINATE => TERMINATE;
|
END SELECT;
|
END SELECT;
|
|
|
FAILED ("TERMINATE NOT SELECTED IN T1");
|
FAILED ("TERMINATE NOT SELECTED IN T1");
|
END;
|
END;
|
END;
|
END;
|
END T1;
|
END T1;
|
|
|
BEGIN
|
BEGIN
|
EVENT ('C');
|
EVENT ('C');
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS => FAILED ("EXCEPTION RECEIVED IN MAIN");
|
WHEN OTHERS => FAILED ("EXCEPTION RECEIVED IN MAIN");
|
END;
|
END;
|
|
|
IF TRACE.GET.TRACE(3) = '.' OR TRACE.GET.TRACE(4) /= '.' THEN
|
IF TRACE.GET.TRACE(3) = '.' OR TRACE.GET.TRACE(4) /= '.' THEN
|
FAILED ("ALL EVENTS NOT PROCESSED CORRECTLY");
|
FAILED ("ALL EVENTS NOT PROCESSED CORRECTLY");
|
END IF;
|
END IF;
|
|
|
COMMENT ("EXECUTION ORDER WAS " & TRACE.GET.TRACE);
|
COMMENT ("EXECUTION ORDER WAS " & TRACE.GET.TRACE);
|
|
|
RESULT;
|
RESULT;
|
END C94008D;
|
END C94008D;
|
|
|