1-- C95021A.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 CALLS TO AN ENTRY ARE PLACED IN A FIFO QUEUE. 26 27-- JBG 2/22/84 28-- DAS 10/8/90 ADDED PRAGMA PRIORITY TO ENSURE THAT THE FIFO 29-- DISCIPLINE MUST BE FOLLOWED (OTHERWISE THE 30-- IMPLEMENTATION MIGHT PROHIBIT QUEUES FROM 31-- FORMING SO THAT E'COUNT IS ALWAYS ZERO FOR 32-- AN ENTRY E). 33-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X. 34 35-- THE TASK QUEUE IS THE TASK THAT CHECKS THE QUEUEING DISCIPLINE. 36-- 37-- THIS TEST PLACES TWO CALLS ON AN ENTRY, WAITS UNTIL ONE OF THE CALLS 38-- IS ACCEPTED, AND THEN PLACES A THIRD CALL ON THE ENTRY. THE TEST 39-- CHECKS THAT THE SECOND CALL IS HANDLED BEFORE THE THIRD. (IT IS 40-- NONDETERMINISTIC WHICH CALL WILL BE THE FIRST ONE ON THE QUEUE, SO 41-- THIS MORE COMPLICATED APPROACH IS NECESSARY.) 42-- 43-- THE TASK DISPATCH FIRES UP THE TWO TASKS THAT MAKE THE FIRST TWO 44-- CALLS AND THEN WAITS UNTIL QUEUE SAYS IT IS READY FOR THE THIRD CALL. 45-- 46-- THE TASK TYPE CALLERS IS USED TO CREATE TASKS THAT WILL CALL THE 47-- ENTRY IN THE TASK QUEUE. 48 49with Impdef; 50WITH REPORT; USE REPORT; 51WITH SYSTEM; 52PROCEDURE C95021A IS 53BEGIN 54 55 TEST ("C95021A", "CHECK THAT ENTRY CALLS ARE PUT IN FIFO QUEUES"); 56 57-- DO THIS TEST 3 TIMES TO ALLOW FOR RANDOM VARIATIONS IN TIMING. 58 FOR I IN 1..3 LOOP 59 COMMENT ("ITERATION" & INTEGER'IMAGE(I)); 60 61 DECLARE 62 63 TASK TYPE CALLERS IS 64 ENTRY NAME (N : NATURAL); 65 END CALLERS; 66 67 TASK QUEUE IS 68 ENTRY GO; 69 ENTRY E1 (NAME : NATURAL); 70 END QUEUE; 71 72 TASK DISPATCH IS 73 ENTRY READY; 74 END DISPATCH; 75 76 TASK BODY CALLERS IS 77 MY_NAME : NATURAL; 78 BEGIN 79 80-- GET NAME OF THIS TASK OBJECT 81 ACCEPT NAME (N : NATURAL) DO 82 MY_NAME := N; 83 END NAME; 84 85-- PUT THIS TASK ON QUEUE FOR QUEUE.E1 86 QUEUE.E1 (MY_NAME); 87 END CALLERS; 88 89 TASK BODY DISPATCH IS 90 TYPE ACC_CALLERS IS ACCESS CALLERS; 91 OBJ : ACC_CALLERS; 92 BEGIN 93 94-- FIRE UP TWO CALLERS FOR QUEUE.E1 95 OBJ := NEW CALLERS; 96 OBJ.NAME(1); 97 OBJ := NEW CALLERS; 98 OBJ.NAME(2); 99 100-- ALLOW THESE CALLS TO BE PROCESSED (ONLY ONE WILL BE ACCEPTED). 101 QUEUE.GO; 102 103-- WAIT TILL ONE CALL HAS BEEN PROCESSED. 104 ACCEPT READY; -- CALLED FROM QUEUE 105 106-- FIRE UP THIRD CALLER 107 OBJ := NEW CALLERS; 108 OBJ.NAME(3); 109 110 END DISPATCH; 111 112 TASK BODY QUEUE IS 113 NEXT : NATURAL; -- NUMBER OF SECOND CALLER IN QUEUE. 114 BEGIN 115 116-- WAIT UNTIL TWO TASKS CALLING E1 HAVE BEEN ACTIVATED. 117 ACCEPT GO; 118 119-- WAIT FOR TWO CALLS TO BE AVAILABLE. THIS WAIT ASSUMES THAT THE 120-- CALLER TASKS WILL PROCEED IF THIS TASK IS EXECUTING A DELAY 121-- STATEMENT, ALTHOUGH THIS IS NOT STRICTLY REQUIRED BY THE STANDARD. 122 FOR I IN 1..6 -- WILL WAIT FOR ONE MINUTE 123 LOOP 124 EXIT WHEN E1'COUNT = 2; 125 DELAY 10.0 * Impdef.One_Second; -- WAIT FOR CALLS TO ARRIVE 126 END LOOP; 127 128 IF E1'COUNT /= 2 THEN 129 FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " & 130 "MINUTE - 1"); 131 END IF; 132 133-- ASSUMING NO FAILURE, PROCESS ONE OF THE QUEUED CALLS. 134 ACCEPT E1 (NAME : NATURAL) DO 135 136-- GET NAME OF NEXT CALLER 137 CASE NAME IS 138 WHEN 1 => 139 NEXT := 2; 140 WHEN 2 => 141 NEXT := 1; 142 WHEN OTHERS => 143 FAILED ("UNEXPECTED ERROR"); 144 END CASE; 145 END E1; 146 147-- TELL DISPATCH TO FIRE UP NEXT CALLER (ONE IS STILL IN QUEUE). 148 DISPATCH.READY; 149 150-- WAIT FOR CALL TO ARRIVE. 151 FOR I IN 1..6 -- WILL WAIT FOR ONE MINUTE 152 LOOP 153 EXIT WHEN E1'COUNT = 2; 154 DELAY 10.0 * Impdef.One_Second; -- WAIT FOR CALLS TO ARRIVE 155 END LOOP; 156 157 IF E1'COUNT /= 2 THEN 158 FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " & 159 "MINUTE - 2"); 160 END IF; 161 162-- ASSUMING NO FAILURE, ACCEPT SECOND CALL AND CHECK THAT IT IS FROM THE 163-- CORRECT TASK. 164 ACCEPT E1 (NAME : NATURAL) DO 165 IF NAME /= NEXT THEN 166 FAILED ("FIFO DISCIPLINE NOT OBEYED"); 167 END IF; 168 END E1; 169 170-- ACCEPT THE LAST CALLER 171 ACCEPT E1 (NAME : NATURAL); 172 173 END QUEUE; 174 175 BEGIN 176 NULL; 177 END; -- ALL TASKS NOW TERMINATED. 178 END LOOP; 179 180 RESULT; 181 182END C95021A; 183