1-- C94008D.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 CORRECT OPERATION OF SELECT WITH TERMINATE ALTERNATIVE WHEN 26-- EXECUTED FROM AN INNER BLOCK WITH OUTER DEPENDING TASKS. 27 28-- JEAN-PIERRE ROSEN 03-MAR-84 29-- JRK 4/7/86 30-- JBG 9/4/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT/SUBUNIT 31-- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X. 32 33-- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES 34GENERIC 35 TYPE HOLDER_TYPE IS PRIVATE; 36 TYPE VALUE_TYPE IS PRIVATE; 37 INITIAL_VALUE : HOLDER_TYPE; 38 WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE; 39 VALUE : IN HOLDER_TYPE) IS <>; 40 WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE; 41 VALUE : IN VALUE_TYPE) IS <>; 42PACKAGE SHARED_C94008D IS 43 PROCEDURE SET (VALUE : IN HOLDER_TYPE); 44 PROCEDURE UPDATE (VALUE : IN VALUE_TYPE); 45 FUNCTION GET RETURN HOLDER_TYPE; 46END SHARED_C94008D; 47 48PACKAGE BODY SHARED_C94008D IS 49 TASK SHARE IS 50 ENTRY SET (VALUE : IN HOLDER_TYPE); 51 ENTRY UPDATE (VALUE : IN VALUE_TYPE); 52 ENTRY READ (VALUE : OUT HOLDER_TYPE); 53 END SHARE; 54 55 TASK BODY SHARE IS SEPARATE; 56 57 PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS 58 BEGIN 59 SHARE.SET (VALUE); 60 END SET; 61 62 PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS 63 BEGIN 64 SHARE.UPDATE (VALUE); 65 END UPDATE; 66 67 FUNCTION GET RETURN HOLDER_TYPE IS 68 VALUE : HOLDER_TYPE; 69 BEGIN 70 SHARE.READ (VALUE); 71 RETURN VALUE; 72 END GET; 73 74BEGIN 75 SHARE.SET (INITIAL_VALUE); -- SET INITIAL VALUE 76END SHARED_C94008D; 77 78PACKAGE EVENTS_C94008D IS 79 80 TYPE EVENT_TYPE IS 81 RECORD 82 TRACE : STRING (1..4) := "...."; 83 LENGTH : NATURAL := 0; 84 END RECORD; 85 86 PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER); 87 PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE); 88END EVENTS_C94008D; 89 90PACKAGE COUNTER_C94008D IS 91 PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER); 92 PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER); 93END COUNTER_C94008D; 94 95PACKAGE BODY COUNTER_C94008D IS 96 PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS 97 BEGIN 98 VAR := VAR + VAL; 99 END UPDATE; 100 101 PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS 102 BEGIN 103 VAR := VAL; 104 END SET; 105END COUNTER_C94008D; 106 107PACKAGE BODY EVENTS_C94008D IS 108 PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS 109 BEGIN 110 VAR.LENGTH := VAR.LENGTH + 1; 111 VAR.TRACE(VAR.LENGTH) := VAL; 112 END UPDATE; 113 114 PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS 115 BEGIN 116 VAR := VAL; 117 END SET; 118 119END EVENTS_C94008D; 120 121SEPARATE (SHARED_C94008D) 122TASK BODY SHARE IS 123 VARIABLE : HOLDER_TYPE; 124BEGIN 125 LOOP 126 SELECT 127 ACCEPT SET (VALUE : IN HOLDER_TYPE) DO 128 SHARED_C94008D.SET (VARIABLE, VALUE); 129 END SET; 130 OR 131 ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO 132 SHARED_C94008D.UPDATE (VARIABLE, VALUE); 133 END UPDATE; 134 OR 135 ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO 136 VALUE := VARIABLE; 137 END READ; 138 OR 139 TERMINATE; 140 END SELECT; 141 END LOOP; 142END SHARE; 143 144with Impdef; 145WITH REPORT; USE REPORT; 146WITH SYSTEM; USE SYSTEM; 147WITH SHARED_C94008D, COUNTER_C94008D, EVENTS_C94008D; 148USE COUNTER_C94008D, EVENTS_C94008D; 149PROCEDURE C94008D IS 150 151 PACKAGE TRACE IS 152 NEW SHARED_C94008D (EVENT_TYPE, CHARACTER, ("....", 0)); 153 PACKAGE TERMINATE_COUNT IS 154 NEW SHARED_C94008D (INTEGER, INTEGER, 0); 155 156 PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE; 157 158 FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS 159 BEGIN 160 TERMINATE_COUNT.UPDATE (1); 161 RETURN TRUE; 162 END ENTER_TERMINATE; 163 164BEGIN 165 TEST ("C94008D", "CHECK CORRECT OPERATION OF SELECT WITH " & 166 "TERMINATE ALTERNATIVE FROM AN INNER BLOCK"); 167 168 DECLARE 169 170 TASK T1 IS 171 ENTRY E1; 172 END T1; 173 174 TASK BODY T1 IS 175 BEGIN 176 DECLARE 177 178 TASK T2 IS 179 ENTRY E2; 180 END T2; 181 182 TASK BODY T2 IS 183 BEGIN 184 DELAY 10.0 * Impdef.One_Second; 185 186 IF TERMINATE_COUNT.GET /= 1 THEN 187 DELAY 20.0 * Impdef.One_Second; 188 END IF; 189 190 IF TERMINATE_COUNT.GET /= 1 THEN 191 FAILED ("30 SECOND DELAY NOT ENOUGH"); 192 END IF; 193 194 IF T1'TERMINATED OR NOT T1'CALLABLE THEN 195 FAILED ("T1 PREMATURELY TERMINATED"); 196 END IF; 197 198 EVENT ('A'); 199 200 SELECT 201 ACCEPT E2; 202 OR TERMINATE; 203 END SELECT; 204 205 FAILED ("TERMINATE NOT SELECTED IN T2"); 206 END T2; 207 208 BEGIN 209 BEGIN 210 EVENT ('B'); 211 212 SELECT 213 ACCEPT E1; 214 OR WHEN ENTER_TERMINATE => TERMINATE; 215 END SELECT; 216 217 FAILED ("TERMINATE NOT SELECTED IN T1"); 218 END; 219 END; 220 END T1; 221 222 BEGIN 223 EVENT ('C'); 224 EXCEPTION 225 WHEN OTHERS => FAILED ("EXCEPTION RECEIVED IN MAIN"); 226 END; 227 228 IF TRACE.GET.TRACE(3) = '.' OR TRACE.GET.TRACE(4) /= '.' THEN 229 FAILED ("ALL EVENTS NOT PROCESSED CORRECTLY"); 230 END IF; 231 232 COMMENT ("EXECUTION ORDER WAS " & TRACE.GET.TRACE); 233 234 RESULT; 235END C94008D; 236