URL
https://opencores.org/ocsvn/scarts/scarts/trunk
Subversion Repositories scarts
[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c97307a.ada] - Rev 12
Compare with Previous | Blame | View Log
-- C97307A.ADA -- Grant of Unlimited Rights -- -- 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 -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- 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 -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- CHECK THAT A TIMED ENTRY CALL THAT IS CANCELED (BECAUSE THE DELAY HAS -- EXPIRED) IS REMOVED FROM THE QUEUE OF THE CALLED TASK'S ENTRY. -- WRG 7/14/86 with Impdef; WITH REPORT; USE REPORT; PROCEDURE C97307A IS BEGIN TEST ("C97307A", "CHECK THAT A TIMED ENTRY CALL THAT IS " & "CANCELED (BECAUSE THE DELAY HAS EXPIRED) IS " & "REMOVED FROM THE QUEUE OF THE CALLED TASK'S " & "ENTRY"); DECLARE DELAY_TIME : CONSTANT DURATION := 2 * 60.0 * Impdef.One_Second; TASK EXPIRED IS ENTRY INCREMENT; ENTRY READ (COUNT : OUT NATURAL); END EXPIRED; TASK TYPE NON_TIMED_CALLER IS ENTRY NAME (N : NATURAL); END NON_TIMED_CALLER; TASK TYPE TIMED_CALLER IS ENTRY NAME (N : NATURAL); END TIMED_CALLER; CALLER1 : TIMED_CALLER; CALLER2 : NON_TIMED_CALLER; CALLER3 : TIMED_CALLER; CALLER4 : NON_TIMED_CALLER; CALLER5 : TIMED_CALLER; TASK T IS ENTRY E (NAME : NATURAL); END T; TASK DISPATCH IS ENTRY READY; END DISPATCH; -------------------------------------------------- TASK BODY EXPIRED IS EXPIRED_CALLS : NATURAL := 0; BEGIN LOOP SELECT ACCEPT INCREMENT DO EXPIRED_CALLS := EXPIRED_CALLS + 1; END INCREMENT; OR ACCEPT READ (COUNT : OUT NATURAL) DO COUNT := EXPIRED_CALLS; END READ; OR TERMINATE; END SELECT; END LOOP; END EXPIRED; -------------------------------------------------- TASK BODY NON_TIMED_CALLER IS MY_NAME : NATURAL; BEGIN ACCEPT NAME (N : NATURAL) DO MY_NAME := N; END NAME; T.E (MY_NAME); END NON_TIMED_CALLER; -------------------------------------------------- TASK BODY TIMED_CALLER IS MY_NAME : NATURAL; BEGIN ACCEPT NAME (N : NATURAL) DO MY_NAME := N; END NAME; SELECT T.E (MY_NAME); FAILED ("TIMED ENTRY CALL NOT CANCELED FOR CALLER" & NATURAL'IMAGE(MY_NAME)); OR DELAY DELAY_TIME; EXPIRED.INCREMENT; END SELECT; EXCEPTION WHEN OTHERS => FAILED ("EXCEPTION RAISED IN TIMED_CALLER -- " & "CALLER" & NATURAL'IMAGE(MY_NAME)); END TIMED_CALLER; -------------------------------------------------- TASK BODY DISPATCH IS BEGIN CALLER1.NAME (1); ACCEPT READY; CALLER2.NAME (2); ACCEPT READY; CALLER3.NAME (3); ACCEPT READY; CALLER4.NAME (4); ACCEPT READY; CALLER5.NAME (5); END DISPATCH; -------------------------------------------------- TASK BODY T IS DESIRED_QUEUE_LENGTH : NATURAL := 1; EXPIRED_CALLS : NATURAL; ACCEPTED : ARRAY (1..5) OF NATURAL RANGE 0..5 := (OTHERS => 0); ACCEPTED_INDEX : NATURAL := 0; BEGIN LOOP LOOP EXPIRED.READ (EXPIRED_CALLS); EXIT WHEN E'COUNT >= DESIRED_QUEUE_LENGTH - EXPIRED_CALLS; DELAY 2.0 * Impdef.One_Second; END LOOP; EXIT WHEN DESIRED_QUEUE_LENGTH = 5; DISPATCH.READY; DESIRED_QUEUE_LENGTH := DESIRED_QUEUE_LENGTH + 1; END LOOP; -- AT THIS POINT, FIVE TASKS WERE QUEUED. -- LET THE TIMED ENTRY CALLS ISSUED BY CALLER1, -- CALLER3, AND CALLER5 EXPIRE: DELAY DELAY_TIME + 10.0 * Impdef.One_Second; -- AT THIS POINT, ALL THE TIMED ENTRY CALLS MUST HAVE -- EXPIRED AND BEEN REMOVED FROM THE ENTRY QUEUE FOR E, -- OTHERWISE THE IMPLEMENTATION HAS FAILED THIS TEST. WHILE E'COUNT > 0 LOOP ACCEPT E (NAME : NATURAL) DO ACCEPTED_INDEX := ACCEPTED_INDEX + 1; ACCEPTED (ACCEPTED_INDEX) := NAME; END E; END LOOP; IF ACCEPTED /= (2, 4, 0, 0, 0) THEN FAILED ("SOME TIMED CALLS NOT REMOVED FROM ENTRY " & "QUEUE"); COMMENT ("ORDER ACCEPTED WAS:" & NATURAL'IMAGE (ACCEPTED (1)) & ',' & NATURAL'IMAGE (ACCEPTED (2)) & ',' & NATURAL'IMAGE (ACCEPTED (3)) & ',' & NATURAL'IMAGE (ACCEPTED (4)) & ',' & NATURAL'IMAGE (ACCEPTED (5)) ); END IF; END T; -------------------------------------------------- BEGIN NULL; END; RESULT; END C97307A;