-- C95021A.ADA
|
-- C95021A.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 CALLS TO AN ENTRY ARE PLACED IN A FIFO QUEUE.
|
-- CHECK THAT CALLS TO AN ENTRY ARE PLACED IN A FIFO QUEUE.
|
|
|
-- JBG 2/22/84
|
-- JBG 2/22/84
|
-- DAS 10/8/90 ADDED PRAGMA PRIORITY TO ENSURE THAT THE FIFO
|
-- DAS 10/8/90 ADDED PRAGMA PRIORITY TO ENSURE THAT THE FIFO
|
-- DISCIPLINE MUST BE FOLLOWED (OTHERWISE THE
|
-- DISCIPLINE MUST BE FOLLOWED (OTHERWISE THE
|
-- IMPLEMENTATION MIGHT PROHIBIT QUEUES FROM
|
-- IMPLEMENTATION MIGHT PROHIBIT QUEUES FROM
|
-- FORMING SO THAT E'COUNT IS ALWAYS ZERO FOR
|
-- FORMING SO THAT E'COUNT IS ALWAYS ZERO FOR
|
-- AN ENTRY E).
|
-- AN ENTRY E).
|
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
|
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
|
|
|
-- THE TASK QUEUE IS THE TASK THAT CHECKS THE QUEUEING DISCIPLINE.
|
-- THE TASK QUEUE IS THE TASK THAT CHECKS THE QUEUEING DISCIPLINE.
|
--
|
--
|
-- THIS TEST PLACES TWO CALLS ON AN ENTRY, WAITS UNTIL ONE OF THE CALLS
|
-- THIS TEST PLACES TWO CALLS ON AN ENTRY, WAITS UNTIL ONE OF THE CALLS
|
-- IS ACCEPTED, AND THEN PLACES A THIRD CALL ON THE ENTRY. THE TEST
|
-- IS ACCEPTED, AND THEN PLACES A THIRD CALL ON THE ENTRY. THE TEST
|
-- CHECKS THAT THE SECOND CALL IS HANDLED BEFORE THE THIRD. (IT IS
|
-- CHECKS THAT THE SECOND CALL IS HANDLED BEFORE THE THIRD. (IT IS
|
-- NONDETERMINISTIC WHICH CALL WILL BE THE FIRST ONE ON THE QUEUE, SO
|
-- NONDETERMINISTIC WHICH CALL WILL BE THE FIRST ONE ON THE QUEUE, SO
|
-- THIS MORE COMPLICATED APPROACH IS NECESSARY.)
|
-- THIS MORE COMPLICATED APPROACH IS NECESSARY.)
|
--
|
--
|
-- THE TASK DISPATCH FIRES UP THE TWO TASKS THAT MAKE THE FIRST TWO
|
-- THE TASK DISPATCH FIRES UP THE TWO TASKS THAT MAKE THE FIRST TWO
|
-- CALLS AND THEN WAITS UNTIL QUEUE SAYS IT IS READY FOR THE THIRD CALL.
|
-- CALLS AND THEN WAITS UNTIL QUEUE SAYS IT IS READY FOR THE THIRD CALL.
|
--
|
--
|
-- THE TASK TYPE CALLERS IS USED TO CREATE TASKS THAT WILL CALL THE
|
-- THE TASK TYPE CALLERS IS USED TO CREATE TASKS THAT WILL CALL THE
|
-- ENTRY IN THE TASK QUEUE.
|
-- ENTRY IN THE TASK QUEUE.
|
|
|
with Impdef;
|
with Impdef;
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
WITH SYSTEM;
|
WITH SYSTEM;
|
PROCEDURE C95021A IS
|
PROCEDURE C95021A IS
|
BEGIN
|
BEGIN
|
|
|
TEST ("C95021A", "CHECK THAT ENTRY CALLS ARE PUT IN FIFO QUEUES");
|
TEST ("C95021A", "CHECK THAT ENTRY CALLS ARE PUT IN FIFO QUEUES");
|
|
|
-- DO THIS TEST 3 TIMES TO ALLOW FOR RANDOM VARIATIONS IN TIMING.
|
-- DO THIS TEST 3 TIMES TO ALLOW FOR RANDOM VARIATIONS IN TIMING.
|
FOR I IN 1..3 LOOP
|
FOR I IN 1..3 LOOP
|
COMMENT ("ITERATION" & INTEGER'IMAGE(I));
|
COMMENT ("ITERATION" & INTEGER'IMAGE(I));
|
|
|
DECLARE
|
DECLARE
|
|
|
TASK TYPE CALLERS IS
|
TASK TYPE CALLERS IS
|
ENTRY NAME (N : NATURAL);
|
ENTRY NAME (N : NATURAL);
|
END CALLERS;
|
END CALLERS;
|
|
|
TASK QUEUE IS
|
TASK QUEUE IS
|
ENTRY GO;
|
ENTRY GO;
|
ENTRY E1 (NAME : NATURAL);
|
ENTRY E1 (NAME : NATURAL);
|
END QUEUE;
|
END QUEUE;
|
|
|
TASK DISPATCH IS
|
TASK DISPATCH IS
|
ENTRY READY;
|
ENTRY READY;
|
END DISPATCH;
|
END DISPATCH;
|
|
|
TASK BODY CALLERS IS
|
TASK BODY CALLERS IS
|
MY_NAME : NATURAL;
|
MY_NAME : NATURAL;
|
BEGIN
|
BEGIN
|
|
|
-- GET NAME OF THIS TASK OBJECT
|
-- GET NAME OF THIS TASK OBJECT
|
ACCEPT NAME (N : NATURAL) DO
|
ACCEPT NAME (N : NATURAL) DO
|
MY_NAME := N;
|
MY_NAME := N;
|
END NAME;
|
END NAME;
|
|
|
-- PUT THIS TASK ON QUEUE FOR QUEUE.E1
|
-- PUT THIS TASK ON QUEUE FOR QUEUE.E1
|
QUEUE.E1 (MY_NAME);
|
QUEUE.E1 (MY_NAME);
|
END CALLERS;
|
END CALLERS;
|
|
|
TASK BODY DISPATCH IS
|
TASK BODY DISPATCH IS
|
TYPE ACC_CALLERS IS ACCESS CALLERS;
|
TYPE ACC_CALLERS IS ACCESS CALLERS;
|
OBJ : ACC_CALLERS;
|
OBJ : ACC_CALLERS;
|
BEGIN
|
BEGIN
|
|
|
-- FIRE UP TWO CALLERS FOR QUEUE.E1
|
-- FIRE UP TWO CALLERS FOR QUEUE.E1
|
OBJ := NEW CALLERS;
|
OBJ := NEW CALLERS;
|
OBJ.NAME(1);
|
OBJ.NAME(1);
|
OBJ := NEW CALLERS;
|
OBJ := NEW CALLERS;
|
OBJ.NAME(2);
|
OBJ.NAME(2);
|
|
|
-- ALLOW THESE CALLS TO BE PROCESSED (ONLY ONE WILL BE ACCEPTED).
|
-- ALLOW THESE CALLS TO BE PROCESSED (ONLY ONE WILL BE ACCEPTED).
|
QUEUE.GO;
|
QUEUE.GO;
|
|
|
-- WAIT TILL ONE CALL HAS BEEN PROCESSED.
|
-- WAIT TILL ONE CALL HAS BEEN PROCESSED.
|
ACCEPT READY; -- CALLED FROM QUEUE
|
ACCEPT READY; -- CALLED FROM QUEUE
|
|
|
-- FIRE UP THIRD CALLER
|
-- FIRE UP THIRD CALLER
|
OBJ := NEW CALLERS;
|
OBJ := NEW CALLERS;
|
OBJ.NAME(3);
|
OBJ.NAME(3);
|
|
|
END DISPATCH;
|
END DISPATCH;
|
|
|
TASK BODY QUEUE IS
|
TASK BODY QUEUE IS
|
NEXT : NATURAL; -- NUMBER OF SECOND CALLER IN QUEUE.
|
NEXT : NATURAL; -- NUMBER OF SECOND CALLER IN QUEUE.
|
BEGIN
|
BEGIN
|
|
|
-- WAIT UNTIL TWO TASKS CALLING E1 HAVE BEEN ACTIVATED.
|
-- WAIT UNTIL TWO TASKS CALLING E1 HAVE BEEN ACTIVATED.
|
ACCEPT GO;
|
ACCEPT GO;
|
|
|
-- WAIT FOR TWO CALLS TO BE AVAILABLE. THIS WAIT ASSUMES THAT THE
|
-- WAIT FOR TWO CALLS TO BE AVAILABLE. THIS WAIT ASSUMES THAT THE
|
-- CALLER TASKS WILL PROCEED IF THIS TASK IS EXECUTING A DELAY
|
-- CALLER TASKS WILL PROCEED IF THIS TASK IS EXECUTING A DELAY
|
-- STATEMENT, ALTHOUGH THIS IS NOT STRICTLY REQUIRED BY THE STANDARD.
|
-- STATEMENT, ALTHOUGH THIS IS NOT STRICTLY REQUIRED BY THE STANDARD.
|
FOR I IN 1..6 -- WILL WAIT FOR ONE MINUTE
|
FOR I IN 1..6 -- WILL WAIT FOR ONE MINUTE
|
LOOP
|
LOOP
|
EXIT WHEN E1'COUNT = 2;
|
EXIT WHEN E1'COUNT = 2;
|
DELAY 10.0 * Impdef.One_Second; -- WAIT FOR CALLS TO ARRIVE
|
DELAY 10.0 * Impdef.One_Second; -- WAIT FOR CALLS TO ARRIVE
|
END LOOP;
|
END LOOP;
|
|
|
IF E1'COUNT /= 2 THEN
|
IF E1'COUNT /= 2 THEN
|
FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
|
FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
|
"MINUTE - 1");
|
"MINUTE - 1");
|
END IF;
|
END IF;
|
|
|
-- ASSUMING NO FAILURE, PROCESS ONE OF THE QUEUED CALLS.
|
-- ASSUMING NO FAILURE, PROCESS ONE OF THE QUEUED CALLS.
|
ACCEPT E1 (NAME : NATURAL) DO
|
ACCEPT E1 (NAME : NATURAL) DO
|
|
|
-- GET NAME OF NEXT CALLER
|
-- GET NAME OF NEXT CALLER
|
CASE NAME IS
|
CASE NAME IS
|
WHEN 1 =>
|
WHEN 1 =>
|
NEXT := 2;
|
NEXT := 2;
|
WHEN 2 =>
|
WHEN 2 =>
|
NEXT := 1;
|
NEXT := 1;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("UNEXPECTED ERROR");
|
FAILED ("UNEXPECTED ERROR");
|
END CASE;
|
END CASE;
|
END E1;
|
END E1;
|
|
|
-- TELL DISPATCH TO FIRE UP NEXT CALLER (ONE IS STILL IN QUEUE).
|
-- TELL DISPATCH TO FIRE UP NEXT CALLER (ONE IS STILL IN QUEUE).
|
DISPATCH.READY;
|
DISPATCH.READY;
|
|
|
-- WAIT FOR CALL TO ARRIVE.
|
-- WAIT FOR CALL TO ARRIVE.
|
FOR I IN 1..6 -- WILL WAIT FOR ONE MINUTE
|
FOR I IN 1..6 -- WILL WAIT FOR ONE MINUTE
|
LOOP
|
LOOP
|
EXIT WHEN E1'COUNT = 2;
|
EXIT WHEN E1'COUNT = 2;
|
DELAY 10.0 * Impdef.One_Second; -- WAIT FOR CALLS TO ARRIVE
|
DELAY 10.0 * Impdef.One_Second; -- WAIT FOR CALLS TO ARRIVE
|
END LOOP;
|
END LOOP;
|
|
|
IF E1'COUNT /= 2 THEN
|
IF E1'COUNT /= 2 THEN
|
FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
|
FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
|
"MINUTE - 2");
|
"MINUTE - 2");
|
END IF;
|
END IF;
|
|
|
-- ASSUMING NO FAILURE, ACCEPT SECOND CALL AND CHECK THAT IT IS FROM THE
|
-- ASSUMING NO FAILURE, ACCEPT SECOND CALL AND CHECK THAT IT IS FROM THE
|
-- CORRECT TASK.
|
-- CORRECT TASK.
|
ACCEPT E1 (NAME : NATURAL) DO
|
ACCEPT E1 (NAME : NATURAL) DO
|
IF NAME /= NEXT THEN
|
IF NAME /= NEXT THEN
|
FAILED ("FIFO DISCIPLINE NOT OBEYED");
|
FAILED ("FIFO DISCIPLINE NOT OBEYED");
|
END IF;
|
END IF;
|
END E1;
|
END E1;
|
|
|
-- ACCEPT THE LAST CALLER
|
-- ACCEPT THE LAST CALLER
|
ACCEPT E1 (NAME : NATURAL);
|
ACCEPT E1 (NAME : NATURAL);
|
|
|
END QUEUE;
|
END QUEUE;
|
|
|
BEGIN
|
BEGIN
|
NULL;
|
NULL;
|
END; -- ALL TASKS NOW TERMINATED.
|
END; -- ALL TASKS NOW TERMINATED.
|
END LOOP;
|
END LOOP;
|
|
|
RESULT;
|
RESULT;
|
|
|
END C95021A;
|
END C95021A;
|
|
|