1-- C97307A.ADA 2 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- CHECK THAT A TIMED ENTRY CALL THAT IS CANCELED (BECAUSE THE DELAY HAS 26-- EXPIRED) IS REMOVED FROM THE QUEUE OF THE CALLED TASK'S ENTRY. 27 28-- WRG 7/14/86 29 30with Impdef; 31WITH REPORT; USE REPORT; 32PROCEDURE C97307A IS 33 34BEGIN 35 36 TEST ("C97307A", "CHECK THAT A TIMED ENTRY CALL THAT IS " & 37 "CANCELED (BECAUSE THE DELAY HAS EXPIRED) IS " & 38 "REMOVED FROM THE QUEUE OF THE CALLED TASK'S " & 39 "ENTRY"); 40 41 DECLARE 42 43 DELAY_TIME : CONSTANT DURATION := 2 * 60.0 * Impdef.One_Second; 44 45 TASK EXPIRED IS 46 ENTRY INCREMENT; 47 ENTRY READ (COUNT : OUT NATURAL); 48 END EXPIRED; 49 50 TASK TYPE NON_TIMED_CALLER IS 51 ENTRY NAME (N : NATURAL); 52 END NON_TIMED_CALLER; 53 54 TASK TYPE TIMED_CALLER IS 55 ENTRY NAME (N : NATURAL); 56 END TIMED_CALLER; 57 58 CALLER1 : TIMED_CALLER; 59 CALLER2 : NON_TIMED_CALLER; 60 CALLER3 : TIMED_CALLER; 61 CALLER4 : NON_TIMED_CALLER; 62 CALLER5 : TIMED_CALLER; 63 64 TASK T IS 65 ENTRY E (NAME : NATURAL); 66 END T; 67 68 TASK DISPATCH IS 69 ENTRY READY; 70 END DISPATCH; 71 72 -------------------------------------------------- 73 74 TASK BODY EXPIRED IS 75 EXPIRED_CALLS : NATURAL := 0; 76 BEGIN 77 LOOP 78 SELECT 79 ACCEPT INCREMENT DO 80 EXPIRED_CALLS := EXPIRED_CALLS + 1; 81 END INCREMENT; 82 OR 83 ACCEPT READ (COUNT : OUT NATURAL) DO 84 COUNT := EXPIRED_CALLS; 85 END READ; 86 OR 87 TERMINATE; 88 END SELECT; 89 END LOOP; 90 END EXPIRED; 91 92 -------------------------------------------------- 93 94 TASK BODY NON_TIMED_CALLER IS 95 MY_NAME : NATURAL; 96 BEGIN 97 ACCEPT NAME (N : NATURAL) DO 98 MY_NAME := N; 99 END NAME; 100 101 T.E (MY_NAME); 102 END NON_TIMED_CALLER; 103 104 -------------------------------------------------- 105 106 TASK BODY TIMED_CALLER IS 107 MY_NAME : NATURAL; 108 BEGIN 109 ACCEPT NAME (N : NATURAL) DO 110 MY_NAME := N; 111 END NAME; 112 113 SELECT 114 T.E (MY_NAME); 115 FAILED ("TIMED ENTRY CALL NOT CANCELED FOR CALLER" & 116 NATURAL'IMAGE(MY_NAME)); 117 OR 118 DELAY DELAY_TIME; 119 EXPIRED.INCREMENT; 120 END SELECT; 121 EXCEPTION 122 WHEN OTHERS => 123 FAILED ("EXCEPTION RAISED IN TIMED_CALLER -- " & 124 "CALLER" & NATURAL'IMAGE(MY_NAME)); 125 END TIMED_CALLER; 126 127 -------------------------------------------------- 128 129 TASK BODY DISPATCH IS 130 BEGIN 131 CALLER1.NAME (1); 132 ACCEPT READY; 133 134 CALLER2.NAME (2); 135 ACCEPT READY; 136 137 CALLER3.NAME (3); 138 ACCEPT READY; 139 140 CALLER4.NAME (4); 141 ACCEPT READY; 142 143 CALLER5.NAME (5); 144 END DISPATCH; 145 146 -------------------------------------------------- 147 148 TASK BODY T IS 149 150 DESIRED_QUEUE_LENGTH : NATURAL := 1; 151 EXPIRED_CALLS : NATURAL; 152 153 ACCEPTED : ARRAY (1..5) OF NATURAL RANGE 0..5 154 := (OTHERS => 0); 155 ACCEPTED_INDEX : NATURAL := 0; 156 157 BEGIN 158 LOOP 159 LOOP 160 EXPIRED.READ (EXPIRED_CALLS); 161 EXIT WHEN E'COUNT >= DESIRED_QUEUE_LENGTH - 162 EXPIRED_CALLS; 163 DELAY 2.0 * Impdef.One_Long_Second; 164 END LOOP; 165 EXIT WHEN DESIRED_QUEUE_LENGTH = 5; 166 DISPATCH.READY; 167 DESIRED_QUEUE_LENGTH := DESIRED_QUEUE_LENGTH + 1; 168 END LOOP; 169 170 -- AT THIS POINT, FIVE TASKS WERE QUEUED. 171 -- LET THE TIMED ENTRY CALLS ISSUED BY CALLER1, 172 -- CALLER3, AND CALLER5 EXPIRE: 173 174 DELAY DELAY_TIME + 10.0 * Impdef.One_Long_Second; 175 176 -- AT THIS POINT, ALL THE TIMED ENTRY CALLS MUST HAVE 177 -- EXPIRED AND BEEN REMOVED FROM THE ENTRY QUEUE FOR E, 178 -- OTHERWISE THE IMPLEMENTATION HAS FAILED THIS TEST. 179 180 WHILE E'COUNT > 0 LOOP 181 ACCEPT E (NAME : NATURAL) DO 182 ACCEPTED_INDEX := ACCEPTED_INDEX + 1; 183 ACCEPTED (ACCEPTED_INDEX) := NAME; 184 END E; 185 END LOOP; 186 187 IF ACCEPTED /= (2, 4, 0, 0, 0) THEN 188 FAILED ("SOME TIMED CALLS NOT REMOVED FROM ENTRY " & 189 "QUEUE"); 190 COMMENT ("ORDER ACCEPTED WAS:" & 191 NATURAL'IMAGE (ACCEPTED (1)) & ',' & 192 NATURAL'IMAGE (ACCEPTED (2)) & ',' & 193 NATURAL'IMAGE (ACCEPTED (3)) & ',' & 194 NATURAL'IMAGE (ACCEPTED (4)) & ',' & 195 NATURAL'IMAGE (ACCEPTED (5)) ); 196 END IF; 197 END T; 198 199 -------------------------------------------------- 200 201 BEGIN 202 203 NULL; 204 205 END; 206 207 RESULT; 208 209END C97307A; 210