1-- C94002A.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 UNIT WITH DEPENDENT TASKS CREATED BY (LOCAL) 26-- ALLOCATORS DOES NOT TERMINATE UNTIL ALL DEPENDENT TASKS ARE 27-- TERMINATED. 28-- SUBTESTS ARE: 29-- (A, B) A SIMPLE TASK ALLOCATOR, IN A BLOCK. 30-- (C, D) A RECORD OF TASK ALLOCATOR, IN A FUNCTION. 31-- (E, F) A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY. 32 33-- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS. 34 35-- JRK 10/2/81 36-- SPS 11/2/82 37-- SPS 11/21/82 38-- JRK 11/29/82 39-- TBN 8/25/86 REDUCED DELAYS; ADDED LIMITED PRIVATE TYPES; 40-- INCLUDED EXITS BY RAISING AN EXCEPTION. 41-- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X. 42 43with Impdef; 44WITH REPORT; USE REPORT; 45WITH SYSTEM; USE SYSTEM; 46PROCEDURE C94002A IS 47 48 PACKAGE P IS 49 MY_EXCEPTION : EXCEPTION; 50 GLOBAL : INTEGER; 51 TASK TYPE T1 IS 52 ENTRY E (I : INTEGER); 53 END T1; 54 TYPE T2 IS LIMITED PRIVATE; 55 PROCEDURE CALL_ENTRY (A : T2; B : INTEGER); 56 PRIVATE 57 TASK TYPE T2 IS 58 ENTRY E (I : INTEGER); 59 END T2; 60 END P; 61 62 PACKAGE BODY P IS 63 TASK BODY T1 IS 64 LOCAL : INTEGER; 65 BEGIN 66 ACCEPT E (I : INTEGER) DO 67 LOCAL := I; 68 END E; 69 DELAY 30.0 * Impdef.One_Second; -- SINCE THE PARENT UNIT HAS HIGHER 70 -- PRIORITY AT THIS POINT, IT WILL 71 -- RECEIVE CONTROL AND TERMINATE IF 72 -- THE ERROR IS PRESENT. 73 GLOBAL := LOCAL; 74 END T1; 75 76 TASK BODY T2 IS 77 LOCAL : INTEGER; 78 BEGIN 79 ACCEPT E (I : INTEGER) DO 80 LOCAL := I; 81 END E; 82 DELAY 30.0 * Impdef.One_Second; 83 GLOBAL := LOCAL; 84 END T2; 85 86 PROCEDURE CALL_ENTRY (A : T2; B : INTEGER) IS 87 BEGIN 88 A.E (B); 89 END CALL_ENTRY; 90 END P; 91 92 USE P; 93 94 95BEGIN 96 TEST ("C94002A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " & 97 "CREATED BY (LOCAL) ALLOCATORS DOES NOT " & 98 "TERMINATE UNTIL ALL DEPENDENT TASKS " & 99 "ARE TERMINATED"); 100 101 -------------------------------------------------- 102 GLOBAL := IDENT_INT (0); 103 BEGIN -- (A) 104 DECLARE 105 TYPE A_T IS ACCESS T1; 106 A : A_T; 107 BEGIN 108 IF EQUAL (3, 3) THEN 109 A := NEW T1; 110 A.ALL.E (IDENT_INT(1)); 111 RAISE MY_EXCEPTION; 112 END IF; 113 END; 114 115 FAILED ("MY_EXCEPTION WAS NOT RAISED - 1"); 116 EXCEPTION 117 WHEN MY_EXCEPTION => 118 IF GLOBAL /= 1 THEN 119 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " & 120 "BLOCK EXIT - 1"); 121 END IF; 122 WHEN OTHERS => 123 FAILED ("UNEXPECTED EXCEPTION RAISED - 1"); 124 END; -- (A) 125 126 -------------------------------------------------- 127 128 GLOBAL := IDENT_INT (0); 129 130 DECLARE -- (B) 131 TYPE A_T IS ACCESS T2; 132 A : A_T; 133 BEGIN -- (B) 134 IF EQUAL (3, 3) THEN 135 A := NEW T2; 136 CALL_ENTRY (A.ALL, IDENT_INT(2)); 137 END IF; 138 END; -- (B) 139 140 IF GLOBAL /= 2 THEN 141 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " & 142 "BLOCK EXIT - 2"); 143 END IF; 144 145 -------------------------------------------------- 146 147 GLOBAL := IDENT_INT (0); 148 149 DECLARE -- (C) 150 I : INTEGER; 151 152 FUNCTION F RETURN INTEGER IS 153 TYPE RT; 154 TYPE ART IS ACCESS RT; 155 TYPE RT IS 156 RECORD 157 A : ART; 158 T : T1; 159 END RECORD; 160 LIST : ART; 161 TEMP : ART; 162 BEGIN 163 FOR I IN 1 .. IDENT_INT (1) LOOP 164 TEMP := NEW RT; 165 TEMP.A := LIST; 166 LIST := TEMP; 167 LIST.T.E (IDENT_INT(3)); 168 END LOOP; 169 RETURN 0; 170 END F; 171 BEGIN -- (C) 172 I := F; 173 174 IF GLOBAL /= 3 THEN 175 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " & 176 "FUNCTION EXIT - 3"); 177 END IF; 178 END; -- (C) 179 180 -------------------------------------------------- 181 182 GLOBAL := IDENT_INT (0); 183 184 DECLARE -- (D) 185 I : INTEGER; 186 187 FUNCTION F RETURN INTEGER IS 188 TYPE RT; 189 TYPE ART IS ACCESS RT; 190 TYPE RT IS 191 RECORD 192 A : ART; 193 T : T2; 194 END RECORD; 195 LIST : ART; 196 TEMP : ART; 197 BEGIN 198 FOR I IN 1 .. IDENT_INT (1) LOOP 199 TEMP := NEW RT; 200 TEMP.A := LIST; 201 LIST := TEMP; 202 CALL_ENTRY (LIST.T, IDENT_INT(4)); 203 IF EQUAL (3, 3) THEN 204 RAISE MY_EXCEPTION; 205 END IF; 206 END LOOP; 207 RETURN 0; 208 END F; 209 BEGIN -- (D) 210 I := F; 211 212 FAILED ("MY_EXCEPTION WAS NOT RAISED - 4"); 213 EXCEPTION 214 WHEN MY_EXCEPTION => 215 IF GLOBAL /= 4 THEN 216 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " & 217 "FUNCTION EXIT - 4"); 218 END IF; 219 WHEN OTHERS => 220 FAILED ("UNEXPECTED EXCEPTION RAISED - 4"); 221 END; -- (D) 222 223 -------------------------------------------------- 224 225 GLOBAL := IDENT_INT (0); 226 227 DECLARE -- (E) 228 229 LOOP_COUNT : INTEGER := 0; 230 CUT_OFF : CONSTANT := 5 * 60; -- FIVE MINUTE DELAY. 231 232 TASK TSK IS 233 ENTRY ENT; 234 END TSK; 235 236 TASK BODY TSK IS 237 TYPE ARR IS ARRAY (1..1) OF T1; 238 TYPE RAT; 239 TYPE ARAT IS ACCESS RAT; 240 TYPE RAT IS 241 RECORD 242 A : ARAT; 243 T : ARR; 244 END RECORD; 245 LIST : ARAT; 246 TEMP : ARAT; 247 BEGIN 248 FOR I IN 1 .. IDENT_INT (1) LOOP 249 TEMP := NEW RAT; 250 TEMP.A := LIST; 251 LIST := TEMP; 252 LIST.T(1).E (IDENT_INT(5)); 253 IF EQUAL (3, 3) THEN 254 RAISE MY_EXCEPTION; 255 END IF; 256 END LOOP; 257 END TSK; 258 259 BEGIN -- (E) 260 261 WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP 262 DELAY 1.0 * Impdef.One_Second; 263 LOOP_COUNT := LOOP_COUNT + 1; 264 END LOOP; 265 266 IF LOOP_COUNT >= CUT_OFF THEN 267 FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " & 268 "MINUTES - 5"); 269 END IF; 270 271 IF GLOBAL /= 5 THEN 272 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " & 273 "TASK EXIT - 5"); 274 END IF; 275 276 END; -- (E) 277 278 -------------------------------------------------- 279 280 GLOBAL := IDENT_INT (0); 281 282 DECLARE -- (F) 283 284 LOOP_COUNT : INTEGER := 0; 285 CUT_OFF : CONSTANT := 5 * 60; -- FIVE MINUTE DELAY. 286 287 TASK TSK IS 288 ENTRY ENT; 289 END TSK; 290 291 TASK BODY TSK IS 292 TYPE ARR IS ARRAY (1..1) OF T2; 293 TYPE RAT; 294 TYPE ARAT IS ACCESS RAT; 295 TYPE RAT IS 296 RECORD 297 A : ARAT; 298 T : ARR; 299 END RECORD; 300 LIST : ARAT; 301 TEMP : ARAT; 302 BEGIN 303 FOR I IN 1 .. IDENT_INT (1) LOOP 304 TEMP := NEW RAT; 305 TEMP.A := LIST; 306 LIST := TEMP; 307 CALL_ENTRY (LIST.T(1), IDENT_INT(6)); 308 END LOOP; 309 END TSK; 310 311 BEGIN -- (F) 312 313 WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP 314 DELAY 1.0 * Impdef.One_Second; 315 LOOP_COUNT := LOOP_COUNT + 1; 316 END LOOP; 317 318 IF LOOP_COUNT >= CUT_OFF THEN 319 FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " & 320 "MINUTES - 6"); 321 END IF; 322 323 IF GLOBAL /= 6 THEN 324 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " & 325 "TASK EXIT - 6"); 326 END IF; 327 328 END; -- (F) 329 330 RESULT; 331END C94002A; 332