1-- C93004D.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 WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A 26-- TASK, OTHER TASKS ARE UNAFFECTED. 27 28-- THIS TEST CHECKS THE CASE IN WHICH SOME OF THE OTHER TASKS ARE 29-- PERHAPS ACTIVATED BEFORE THE EXCEPTION OCCURS AND SOME TASKS ARE 30-- PERHAPS ACTIVATED AFTER. 31 32-- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR. 33 34-- CHECK THAT TASKS WAITING FOR ENTRIES OF SUCH TASKS RECEIVE 35-- TASKING_ERROR. 36 37-- R. WILLIAMS 8/6/86 38-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X. 39 40WITH SYSTEM; USE SYSTEM; 41WITH REPORT; USE REPORT; 42PROCEDURE C93004D IS 43 44 45BEGIN 46 TEST ( "C93004D", "CHECK THAT WHEN AN EXCEPTION IS RAISED " & 47 "DURING ACTIVATION OF A TASK, OTHER TASKS " & 48 "ARE NOT AFFECTED. IN THIS TEST, SOME OF THE " & 49 "TASKS ARE PERHAPS ACTIVATED BEFORE THE " & 50 "EXCEPTION OCCURS AND SOME PERHAPS AFTER" ); 51 52 53 DECLARE 54 55 TASK T0 IS 56 ENTRY E; 57 END T0; 58 59 TASK TYPE T1 IS 60 END T1; 61 62 TASK TYPE T2 IS 63 ENTRY E; 64 END T2; 65 66 ARR_T2: ARRAY(INTEGER RANGE 1..4) OF T2; 67 68 TYPE AT1 IS ACCESS T1; 69 70 TASK BODY T0 IS 71 BEGIN 72 ACCEPT E; 73 END T0; 74 75 PACKAGE START_T1 IS -- THIS PACKAGE TO AVOID ACCESS 76 END START_T1; -- BEFORE ELABORATION ON T1. 77 78 TASK BODY T1 IS 79 BEGIN 80 DECLARE -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES. 81 TASK T1BIS IS 82 END T1BIS; 83 84 TASK BODY T1BIS IS 85 BEGIN 86 ARR_T2(IDENT_INT(2)).E; 87 FAILED ("RENDEZVOUS COMPLETED - T3"); 88 EXCEPTION 89 WHEN TASKING_ERROR => 90 NULL; 91 WHEN OTHERS => 92 FAILED("ABNORMAL EXCEPTION - T3"); 93 END T1BIS; 94 BEGIN 95 NULL; 96 END; 97 98 ARR_T2(IDENT_INT(2)).E; -- ARR_T2(2) IS NOW 99 -- TERMINATED. 100 101 FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1"); 102 103 EXCEPTION 104 WHEN TASKING_ERROR => 105 NULL; 106 WHEN OTHERS => 107 FAILED("ABNORMAL EXCEPTION - T1"); 108 END; 109 110 PACKAGE BODY START_T1 IS 111 V_AT1 : AT1 := NEW T1; 112 END START_T1; 113 114 TASK BODY T2 IS 115 I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR. 116 BEGIN 117 IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN 118 FAILED("T2 ACTIVATED OK"); 119 END IF; 120 END T2; 121 122 TASK T3 IS 123 ENTRY E; 124 END T3; 125 126 TASK BODY T3 IS 127 BEGIN -- T3 MUST BE ACTIVATED OK. 128 ACCEPT E; 129 END T3; 130 131 BEGIN -- T0, ARR_T2 (1 .. 4), T3 ACTIVATED HERE. 132 133 FAILED ("TASKING_ERROR NOT RAISED IN MAIN"); 134 T3.E; -- CLEAN UP. 135 T0.E; 136 EXCEPTION 137 WHEN TASKING_ERROR => 138 BEGIN 139 T3.E; 140 T0.E; 141 EXCEPTION 142 WHEN TASKING_ERROR => 143 FAILED ("T0 OR T3 NOT ACTIVATED"); 144 END; 145 WHEN CONSTRAINT_ERROR => 146 FAILED ("CONSTRAINT_ERROR RAISED IN MAIN"); 147 WHEN OTHERS => 148 FAILED ("ABNORMAL EXCEPTION IN MAIN-2"); 149 END; 150 151 RESULT; 152END C93004D; 153