1-- C94002F.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 NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL 26-- ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS 27-- TO TERMINATE IF AN EXCEPTION IS RAISED AND HANDLED IN THE 28-- NON-MASTER UNIT. 29 30-- SUBTESTS ARE: 31-- (A) A SIMPLE TASK ALLOCATOR, IN A BLOCK. 32-- (B) A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM. 33-- (C) A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY. 34 35-- TBN 1/20/86 36-- JRK 5/1/86 IMPROVED ERROR RECOVERY. FIXED EXCEPTION HANDLING. 37-- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X. 38 39with Impdef; 40WITH REPORT; USE REPORT; 41WITH SYSTEM; USE SYSTEM; 42PROCEDURE C94002F IS 43 44 MY_EXCEPTION : EXCEPTION; 45 46 TASK TYPE TT IS 47 ENTRY E; 48 END TT; 49 50 TASK BODY TT IS 51 BEGIN 52 ACCEPT E; 53 ACCEPT E; 54 END TT; 55 56 57BEGIN 58 TEST ("C94002F", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " & 59 "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " & 60 "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " & 61 "TERMINATE IF AN EXCEPTION IS RAISED AND " & 62 "HANDLED IN THE NON-MASTER UNIT"); 63 64 -------------------------------------------------- 65 66 DECLARE -- (A) 67 68 TYPE A_T IS ACCESS TT; 69 A1 : A_T; 70 71 BEGIN -- (A) 72 73 DECLARE 74 A2 : A_T; 75 BEGIN 76 A2 := NEW TT; 77 A2.ALL.E; 78 A1 := A2; 79 RAISE MY_EXCEPTION; 80 FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)"); 81 EXCEPTION 82 WHEN MY_EXCEPTION => 83 NULL; 84 WHEN OTHERS => 85 FAILED ("UNEXPECTED EXCEPTION IN (A)"); 86 END; 87 88 IF A1.ALL'TERMINATED THEN 89 FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)"); 90 ELSE A1.ALL.E; 91 END IF; 92 93 END; -- (A) 94 95 -------------------------------------------------- 96 97 DECLARE -- (B) 98 99 I : INTEGER; 100 101 FUNCTION F RETURN INTEGER IS 102 103 TYPE RT IS 104 RECORD 105 T : TT; 106 END RECORD; 107 TYPE ART IS ACCESS RT; 108 AR1 : ART; 109 110 PROCEDURE P (AR : OUT ART) IS 111 AR2 : ART; 112 BEGIN 113 AR2 := NEW RT; 114 AR2.T.E; 115 AR := AR2; 116 RAISE MY_EXCEPTION; 117 FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)"); 118 EXCEPTION 119 WHEN MY_EXCEPTION => 120 NULL; 121 WHEN OTHERS => 122 FAILED ("UNEXPECTED EXCEPTION IN (B)"); 123 END P; 124 125 BEGIN 126 P (AR1); 127 128 IF AR1.T'TERMINATED THEN 129 FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " & 130 "- (B)"); 131 ELSE AR1.T.E; 132 END IF; 133 134 RETURN 0; 135 END F; 136 137 BEGIN -- (B) 138 139 I := F; 140 141 END; -- (B) 142 143 -------------------------------------------------- 144 145 DECLARE -- (C) 146 147 LOOP_COUNT : INTEGER := 0; 148 CUT_OFF : CONSTANT := 60; -- DELAY. 149 150 TASK TSK IS 151 ENTRY ENT; 152 END TSK; 153 154 TASK BODY TSK IS 155 156 LOOP_COUNT1 : INTEGER := 0; 157 CUT_OFF1 : CONSTANT := 60; -- DELAY. 158 159 TYPE RAT; 160 TYPE ARAT IS ACCESS RAT; 161 TYPE ARR IS ARRAY (1..1) OF TT; 162 TYPE RAT IS 163 RECORD 164 A : ARAT; 165 T : ARR; 166 END RECORD; 167 ARA1 : ARAT; 168 169 TASK TSK1 IS 170 ENTRY ENT1 (ARA : OUT ARAT); 171 END TSK1; 172 173 TASK BODY TSK1 IS 174 ARA2 : ARAT; 175 BEGIN 176 ARA2 := NEW RAT; -- INITIATE TASK ARA2.T(1). 177 ARA2.T(1).E; 178 ACCEPT ENT1 (ARA : OUT ARAT) DO 179 ARA := ARA2; 180 END ENT1; 181 RAISE MY_EXCEPTION; 182 FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)"); 183 EXCEPTION 184 WHEN MY_EXCEPTION => 185 NULL; 186 WHEN OTHERS => 187 FAILED ("UNEXPECTED EXCEPTION IN (C)"); 188 END TSK1; 189 190 BEGIN 191 TSK1.ENT1 (ARA1); -- ARA1.T BECOMES ALIAS FOR ARA2.T. 192 193 WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP 194 DELAY 1.0 * Impdef.One_Second; 195 LOOP_COUNT1 := LOOP_COUNT1 + 1; 196 END LOOP; 197 198 IF LOOP_COUNT1 >= CUT_OFF1 THEN 199 FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " & 200 "WITHIN ONE MINUTE - (C)"); 201 END IF; 202 203 IF ARA1.T(1)'TERMINATED THEN 204 FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " & 205 "- (C)"); 206 ELSE ARA1.T(1).E; 207 END IF; 208 END TSK; 209 210 BEGIN -- (C) 211 212 WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP 213 DELAY 2.0 * Impdef.One_Second; 214 LOOP_COUNT := LOOP_COUNT + 1; 215 END LOOP; 216 217 IF LOOP_COUNT >= CUT_OFF THEN 218 FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " & 219 "TWO MINUTES - (C)"); 220 END IF; 221 222 END; -- (C) 223 224 --------------------------------------------------------------- 225 226 RESULT; 227END C94002F; 228