1-- C9A007A.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 TASK MAY ABORT A TASK IT DEPENDS ON. 26 27 28-- RM 5/26/82 29-- RM 7/02/82 30-- SPS 11/21/82 31-- JBG 2/27/84 32-- JBG 3/8/84 33-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X. 34-- EDS 08/04/98 ENSURE THAT ABORTED TASKS HAVE TIME TO EFFECT THEIR ABORTIONS. 35 36WITH IMPDEF; 37WITH REPORT; USE REPORT; 38WITH SYSTEM; USE SYSTEM; 39PROCEDURE C9A007A IS 40 41 TASK_NOT_ABORTED : BOOLEAN := FALSE; 42 TEST_VALID : BOOLEAN := TRUE ; 43 44BEGIN 45 46 47 ------------------------------------------------------------------- 48 49 50 TEST ( "C9A007A" , "CHECK THAT A TASK MAY ABORT A TASK" & 51 " IT DEPENDS ON" ); 52 53 54 DECLARE 55 56 57 TASK REGISTER IS 58 59 60 ENTRY BIRTHS_AND_DEATHS; 61 62 ENTRY SYNC1; 63 ENTRY SYNC2; 64 65 66 END REGISTER; 67 68 69 TASK BODY REGISTER IS 70 71 72 TASK TYPE SECONDARY IS 73 74 75 ENTRY WAIT_INDEFINITELY; 76 77 END SECONDARY; 78 79 80 TASK TYPE T_TYPE1 IS 81 82 83 ENTRY E; 84 85 END T_TYPE1; 86 87 88 TASK TYPE T_TYPE2 IS 89 90 91 ENTRY E; 92 93 END T_TYPE2; 94 95 96 T_OBJECT1 : T_TYPE1; 97 T_OBJECT2 : T_TYPE2; 98 99 100 TASK BODY SECONDARY IS 101 BEGIN 102 SYNC1; 103 ABORT T_OBJECT1; 104 DELAY 0.0; 105 TASK_NOT_ABORTED := TRUE; 106 END SECONDARY; 107 108 109 TASK BODY T_TYPE1 IS 110 111 TYPE ACCESS_TO_TASK IS ACCESS SECONDARY; 112 113 BEGIN 114 115 116 DECLARE 117 DEPENDENT_BY_ACCESS : ACCESS_TO_TASK := 118 NEW SECONDARY ; 119 BEGIN 120 NULL; 121 END; 122 123 124 BIRTHS_AND_DEATHS; 125 -- DURING THIS SUSPENSION 126 -- MOST OF THE TASKS 127 -- ARE ABORTED (FIRST 128 -- TASK #1 -- T_OBJECT1 -- 129 -- THEN #2 ). 130 131 132 TASK_NOT_ABORTED := TRUE; 133 134 135 END T_TYPE1; 136 137 138 TASK BODY T_TYPE2 IS 139 140 TASK INNER_TASK IS 141 142 143 ENTRY WAIT_INDEFINITELY; 144 145 END INNER_TASK; 146 147 TASK BODY INNER_TASK IS 148 BEGIN 149 SYNC2; 150 ABORT T_OBJECT2; 151 DELAY 0.0; 152 TASK_NOT_ABORTED := TRUE; 153 END INNER_TASK; 154 155 BEGIN 156 157 158 BIRTHS_AND_DEATHS; 159 -- DURING THIS SUSPENSION 160 -- MOST OF THE TASKS 161 -- ARE ABORTED (FIRST 162 -- TASK #1 -- T_OBJECT1 -- 163 -- THEN #2 ). 164 165 166 TASK_NOT_ABORTED := TRUE; 167 168 169 END T_TYPE2; 170 171 172 BEGIN 173 174 DECLARE 175 OLD_COUNT : INTEGER := 0; 176 BEGIN 177 178 179 FOR I IN 1..5 LOOP 180 EXIT WHEN BIRTHS_AND_DEATHS'COUNT = 2; 181 DELAY 10.0 * Impdef.One_Second; 182 END LOOP; 183 184 OLD_COUNT := BIRTHS_AND_DEATHS'COUNT; 185 186 IF OLD_COUNT = 2 THEN 187 188 ACCEPT SYNC1; -- ALLOWING ABORT#1 189 190 DELAY IMPDEF.CLEAR_READY_QUEUE; 191 192 -- CHECK THAT #1 WAS ABORTED - 3 WAYS: 193 194 BEGIN 195 T_OBJECT1.E; 196 FAILED( "T_OBJECT1.E DID NOT RAISE" & 197 " TASKING_ERROR" ); 198 EXCEPTION 199 200 WHEN TASKING_ERROR => 201 NULL; 202 203 WHEN OTHERS => 204 FAILED("OTHER EXCEPTION RAISED - 1"); 205 206 END; 207 208 IF T_OBJECT1'CALLABLE THEN 209 FAILED( "T_OBJECT1'CALLABLE = TRUE" ); 210 END IF; 211 212 IF OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1 213 THEN 214 FAILED( "TASK#1 NOT REMOVED FROM QUEUE" ); 215 END IF; 216 217 218 OLD_COUNT := BIRTHS_AND_DEATHS'COUNT; 219 220 221 ACCEPT SYNC2; -- ALLOWING ABORT#2 222 223 DELAY IMPDEF.CLEAR_READY_QUEUE; 224 225 -- CHECK THAT #2 WAS ABORTED - 3 WAYS: 226 227 BEGIN 228 T_OBJECT2.E; 229 FAILED( "T_OBJECT2.E DID NOT RAISE" & 230 " TASKING_ERROR" ); 231 EXCEPTION 232 233 WHEN TASKING_ERROR => 234 NULL; 235 236 WHEN OTHERS => 237 FAILED("OTHER EXCEPTION RAISED - 2"); 238 239 END; 240 241 IF T_OBJECT2'CALLABLE THEN 242 FAILED( "T_OBJECT2'CALLABLE = TRUE" ); 243 END IF; 244 245 IF OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1 246 THEN 247 FAILED( "TASK#2 NOT REMOVED FROM QUEUE" ); 248 END IF; 249 250 251 IF BIRTHS_AND_DEATHS'COUNT /= 0 THEN 252 FAILED( "SOME TASKS STILL QUEUED" ); 253 END IF; 254 255 256 ELSE 257 258 COMMENT( "LINEUP NOT COMPLETE (AFTER 50 S.)" ); 259 TEST_VALID := FALSE; 260 261 END IF; 262 263 264 END; 265 266 267 WHILE BIRTHS_AND_DEATHS'COUNT > 0 LOOP 268 ACCEPT BIRTHS_AND_DEATHS; 269 END LOOP; 270 271 272 END REGISTER; 273 274 275 BEGIN 276 277 NULL; 278 279 END; 280 281 282 ------------------------------------------------------------------- 283 284 285 IF TEST_VALID AND TASK_NOT_ABORTED THEN 286 FAILED( "SOME TASKS NOT ABORTED" ); 287 END IF; 288 289 290 RESULT; 291 292 293END C9A007A; 294