diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97307a.ada')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97307a.ada | 209 |
1 files changed, 209 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97307a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97307a.ada new file mode 100644 index 000000000..32d26e6b3 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97307a.ada @@ -0,0 +1,209 @@ +-- 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_Long_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_Long_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; |