1-- C94002G.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-- OBJECTIVE: 26-- CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL 27-- ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED 28-- TASKS TO TERMINATE IF AN EXCEPTION IS RAISED BUT NOT HANDLED IN 29-- THE NON-MASTER UNIT. 30 31-- SUBTESTS ARE: 32-- (A) A SIMPLE TASK ALLOCATOR, IN A BLOCK. 33-- (B) A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM. 34-- (C) A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY, NOT 35-- DURING RENDEZVOUS. 36-- (D) A LIMITED PRIVATE TASK ALLOCATOR, IN A TASK BODY, DURING 37-- RENDEZVOUS. 38 39-- HISTORY: 40-- TBN 01/20/86 CREATED ORIGINAL TEST. 41-- JRK 05/01/86 IMPROVED ERROR RECOVERY. FIXED EXCEPTION 42-- HANDLING. ADDED CASE (D). 43-- BCB 09/24/87 ADDED A RETURN STATEMENT TO THE HANDLER FOR OTHERS 44-- IN FUNCTION F, CASE B. 45-- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X. 46 47with Impdef; 48WITH REPORT; USE REPORT; 49WITH SYSTEM; USE SYSTEM; 50PROCEDURE C94002G IS 51 52 MY_EXCEPTION : EXCEPTION; 53 54 TASK TYPE TT IS 55 ENTRY E; 56 END TT; 57 58 TASK BODY TT IS 59 BEGIN 60 ACCEPT E; 61 ACCEPT E; 62 END TT; 63 64 65BEGIN 66 TEST ("C94002G", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " & 67 "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " & 68 "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " & 69 "TERMINATE IF AN EXCEPTION IS RAISED BUT NOT " & 70 "HANDLED IN THE NON-MASTER UNIT"); 71 72 -------------------------------------------------- 73 74 DECLARE -- (A) 75 76 TYPE A_T IS ACCESS TT; 77 A1 : A_T; 78 79 BEGIN -- (A) 80 81 DECLARE 82 A2 : A_T; 83 BEGIN 84 A2 := NEW TT; 85 A2.ALL.E; 86 A1 := A2; 87 RAISE MY_EXCEPTION; 88 FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)"); 89 END; 90 91 ABORT A1.ALL; 92 93 EXCEPTION 94 WHEN MY_EXCEPTION => 95 IF A1.ALL'TERMINATED THEN 96 FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - " & 97 "(A)"); 98 ELSE A1.ALL.E; 99 END IF; 100 WHEN OTHERS => 101 FAILED ("UNEXPECTED EXCEPTION IN (A)"); 102 IF A1 /= NULL THEN 103 ABORT A1.ALL; 104 END IF; 105 END; -- (A) 106 107 -------------------------------------------------- 108 109 DECLARE -- (B) 110 111 I : INTEGER; 112 113 FUNCTION F RETURN INTEGER IS 114 115 TYPE RT IS 116 RECORD 117 T : TT; 118 END RECORD; 119 TYPE ART IS ACCESS RT; 120 AR1 : ART; 121 122 PROCEDURE P IS 123 AR2 : ART; 124 BEGIN 125 AR2 := NEW RT; 126 AR2.T.E; 127 AR1 := AR2; 128 RAISE MY_EXCEPTION; 129 FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)"); 130 END P; 131 132 BEGIN 133 P; 134 ABORT AR1.T; 135 RETURN 0; 136 EXCEPTION 137 WHEN MY_EXCEPTION => 138 IF AR1.T'TERMINATED THEN 139 FAILED ("ALLOCATED TASK PREMATURELY " & 140 "TERMINATED - (B)"); 141 ELSE AR1.T.E; 142 END IF; 143 RETURN 0; 144 WHEN OTHERS => 145 FAILED ("UNEXPECTED EXCEPTION IN (B)"); 146 IF AR1 /= NULL THEN 147 ABORT AR1.T; 148 END IF; 149 RETURN 0; 150 END F; 151 152 BEGIN -- (B) 153 154 I := F; 155 156 END; -- (B) 157 158 -------------------------------------------------- 159 160 DECLARE -- (C) 161 162 LOOP_COUNT : INTEGER := 0; 163 CUT_OFF : CONSTANT := 60; -- DELAY. 164 165 TASK TSK IS 166 ENTRY ENT; 167 END TSK; 168 169 TASK BODY TSK IS 170 171 LOOP_COUNT1 : INTEGER := 0; 172 CUT_OFF1 : CONSTANT := 60; -- DELAY. 173 174 TYPE RAT; 175 TYPE ARAT IS ACCESS RAT; 176 TYPE ARR IS ARRAY (1..1) OF TT; 177 TYPE RAT IS 178 RECORD 179 A : ARAT; 180 T : ARR; 181 END RECORD; 182 ARA1 : ARAT; 183 184 TASK TSK1 IS 185 ENTRY ENT1 (ARA : OUT ARAT); 186 END TSK1; 187 188 TASK BODY TSK1 IS 189 ARA2 : ARAT; 190 BEGIN 191 ARA2 := NEW RAT; -- INITIATE TASK ARA2.T(1). 192 ARA2.T(1).E; 193 ACCEPT ENT1 (ARA : OUT ARAT) DO 194 ARA := ARA2; 195 END ENT1; 196 RAISE MY_EXCEPTION; -- NOT PROPOGATED. 197 FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)"); 198 END TSK1; 199 200 BEGIN 201 TSK1.ENT1 (ARA1); -- ARA1.T BECOMES ALIAS FOR ARA2.T. 202 203 WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP 204 DELAY 1.0 * Impdef.One_Second; 205 LOOP_COUNT1 := LOOP_COUNT1 + 1; 206 END LOOP; 207 208 IF LOOP_COUNT1 >= CUT_OFF1 THEN 209 FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " & 210 "WITHIN ONE MINUTE - (C)"); 211 END IF; 212 213 IF ARA1.T(1)'TERMINATED THEN 214 FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " & 215 "- (C)"); 216 ELSE ARA1.T(1).E; 217 END IF; 218 END TSK; 219 220 BEGIN -- (C) 221 222 WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP 223 DELAY 2.0 * Impdef.One_Second; 224 LOOP_COUNT := LOOP_COUNT + 1; 225 END LOOP; 226 227 IF LOOP_COUNT >= CUT_OFF THEN 228 FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " & 229 "TWO MINUTES - (C)"); 230 END IF; 231 232 END; -- (C) 233 234 -------------------------------------------------- 235 236 DECLARE -- (D) 237 238 LOOP_COUNT : INTEGER := 0; 239 CUT_OFF : CONSTANT := 60; -- DELAY. 240 241 TASK TSK IS 242 ENTRY ENT; 243 END TSK; 244 245 TASK BODY TSK IS 246 247 LOOP_COUNT1 : INTEGER := 0; 248 CUT_OFF1 : CONSTANT := 60; -- DELAY. 249 250 PACKAGE PKG IS 251 TYPE LPT IS LIMITED PRIVATE; 252 PROCEDURE CALL (X : LPT); 253 PROCEDURE KILL (X : LPT); 254 FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN; 255 PRIVATE 256 TYPE LPT IS NEW TT; 257 END PKG; 258 259 USE PKG; 260 261 TYPE ALPT IS ACCESS LPT; 262 ALP1 : ALPT; 263 264 PACKAGE BODY PKG IS 265 PROCEDURE CALL (X : LPT) IS 266 BEGIN 267 X.E; 268 END CALL; 269 270 PROCEDURE KILL (X : LPT) IS 271 BEGIN 272 ABORT X; 273 END KILL; 274 275 FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN IS 276 BEGIN 277 RETURN X'TERMINATED; 278 END TERMINATED; 279 END PKG; 280 281 TASK TSK1 IS 282 ENTRY ENT1 (ALP : OUT ALPT); 283 ENTRY DIE; 284 END TSK1; 285 286 TASK BODY TSK1 IS 287 ALP2 : ALPT; 288 BEGIN 289 ALP2 := NEW LPT; -- INITIATE TASK ALP2.ALL. 290 CALL (ALP2.ALL); 291 ACCEPT ENT1 (ALP : OUT ALPT) DO 292 ALP := ALP2; 293 END ENT1; 294 ACCEPT DIE DO 295 RAISE MY_EXCEPTION; -- PROPOGATED. 296 FAILED ("MY_EXCEPTION WAS NOT RAISED IN (D)"); 297 END DIE; 298 END TSK1; 299 300 BEGIN 301 TSK1.ENT1 (ALP1); -- ALP1.ALL BECOMES ALIAS FOR ALP2.ALL. 302 TSK1.DIE; 303 FAILED ("MY_EXCEPTION WAS NOT PROPOGATED TO CALLING " & 304 "TASK - (D)"); 305 KILL (ALP1.ALL); 306 ABORT TSK1; 307 EXCEPTION 308 WHEN MY_EXCEPTION => 309 WHILE NOT TSK1'TERMINATED AND 310 LOOP_COUNT1 < CUT_OFF1 LOOP 311 DELAY 1.0 * Impdef.One_Second; 312 LOOP_COUNT1 := LOOP_COUNT1 + 1; 313 END LOOP; 314 315 IF LOOP_COUNT1 >= CUT_OFF1 THEN 316 FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " & 317 "WITHIN ONE MINUTE - (D)"); 318 END IF; 319 320 IF TERMINATED (ALP1.ALL) THEN 321 FAILED ("ALLOCATED TASK PREMATURELY " & 322 "TERMINATED - (D)"); 323 ELSE CALL (ALP1.ALL); 324 END IF; 325 WHEN OTHERS => 326 FAILED ("UNEXPECTED EXCEPTION IN (D)"); 327 IF ALP1 /= NULL THEN 328 KILL (ALP1.ALL); 329 END IF; 330 ABORT TSK1; 331 END TSK; 332 333 BEGIN -- (D) 334 335 WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP 336 DELAY 2.0 * Impdef.One_Second; 337 LOOP_COUNT := LOOP_COUNT + 1; 338 END LOOP; 339 340 IF LOOP_COUNT >= CUT_OFF THEN 341 FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " & 342 "TWO MINUTES - (D)"); 343 END IF; 344 345 END; -- (D) 346 347 -------------------------------------------------- 348 349 RESULT; 350END C94002G; 351