1-- C93005F.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 IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE 26-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES 27-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A 28-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR. 29 30-- CASE 4: TASKS IN STATEMENT PART OF A BLOCK. THE TASKS DEPEND ON THE 31-- DECLARATIVE PART. 32 33-- RAC 19-MAR-1985 34-- JBG 06/03/85 35-- EG 10/30/85 ELIMINATE THE USE OF NUMERIC_ERROR IN TEST. 36-- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X. 37-- RLB 06/29/01 CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION. 38 39WITH REPORT; USE REPORT; 40WITH SYSTEM; USE SYSTEM; 41PRAGMA ELABORATE (REPORT); 42PACKAGE C93005F_PK1 IS 43 44 -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED. 45 TASK TYPE UNACTIVATED IS 46 ENTRY E; 47 END UNACTIVATED; 48 49 TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED; 50 51 TYPE BAD_REC IS 52 RECORD 53 T : UNACTIVATED; 54 I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR. 55 END RECORD; 56 57 TYPE ACC_BAD_REC IS ACCESS BAD_REC; 58 59 60 -- ******************************************* 61 -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS 62 -- ******************************************* 63 -- 64 -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT 65 -- TERMINATE). WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS 66 -- INCREMENTED AND A TASK IS CREATED. THE TASK WILL DECREMENT THE 67 -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED. 68 -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT 69 -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR 70 -- DECREMENT). 71 72 -- AN MNT TASK. SUCH TASKS MUST NOT BE TERMINATED 73 -- BY ANYONE BUT THEMSELVES. 74 -- 75 TASK TYPE MNT_TASK IS 76 END MNT_TASK; 77 78 FUNCTION F RETURN INTEGER; 79 80 -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK 81 -- AND FORCE CALLING F BEFORE CREATING THE TASK. 82 -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE 83 -- COUNT. 84 -- 85 TYPE MNT IS 86 RECORD 87 DUMMY : INTEGER := F; 88 T : MNT_TASK; 89 END RECORD; 90 91 PROCEDURE CHECK; 92 93 94 -- ******************************************* 95 -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS 96 -- ******************************************* 97 98END C93005F_PK1; 99 100with Impdef; 101PACKAGE BODY C93005F_PK1 IS 102 103-- THIS TASK IS CALLED IF AN UNACTIVATED TASK 104-- IS EVER INCORRECTLY ACTIVATED. IT REPORTS FAILURE. 105 106 TASK T IS 107 ENTRY E; 108 END; 109 110 -- *********************************************** 111 -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS 112 -- *********************************************** 113 114-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND 115-- ARE STILL ACTIVE. 116 117 MNT_COUNT : INTEGER := 0; 118 119-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE 120 121 TASK MNT_COUNTER IS 122 ENTRY INCR; 123 ENTRY DECR; 124 END MNT_COUNTER; 125 126-- SYNCHRONIZING TASK 127 128 TASK BODY MNT_COUNTER IS 129 BEGIN 130 LOOP 131 SELECT 132 ACCEPT INCR DO 133 MNT_COUNT := MNT_COUNT +1; 134 END INCR; 135 136 OR ACCEPT DECR DO 137 MNT_COUNT := MNT_COUNT -1; 138 END DECR; 139 140 OR TERMINATE; 141 142 END SELECT; 143 END LOOP; 144 END MNT_COUNTER; 145 146-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED 147-- 148 FUNCTION F RETURN INTEGER IS 149 BEGIN 150 MNT_COUNTER.INCR; 151 RETURN 0; 152 END F; 153 154-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE 155-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK 156-- ITSELF IS NOT TERMINATED. 157-- 158 PROCEDURE CHECK IS 159 BEGIN 160 IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN 161 FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " & 162 "TERMINATED"); 163 END IF; 164-- RESET THE COUNT FOR THE NEXT SUBTEST: 165 MNT_COUNT := 0; 166 END CHECK; 167 168-- A MUST NOT BE TERMINATED TASK. DELAY LONG ENOUGH 169-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE. THEN 170-- DECREMENT THE COUNTER. 171-- 172 TASK BODY MNT_TASK IS 173 BEGIN 174 DELAY 5.0 * Impdef.One_Second; 175 MNT_COUNTER.DECR; 176 END MNT_TASK; 177 178 -- *********************************************** 179 -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS 180 -- *********************************************** 181 182 TASK BODY T IS 183 BEGIN 184 LOOP 185 SELECT 186 ACCEPT E DO 187 FAILED ("SOME TYPE U TASK WAS ACTIVATED"); 188 END E; 189 190 OR TERMINATE; 191 END SELECT; 192 END LOOP; 193 END T; 194 195 -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED. 196 -- 197 TASK BODY UNACTIVATED IS 198 BEGIN 199 T.E; 200 END UNACTIVATED; 201END C93005F_PK1; 202 203WITH REPORT, C93005F_PK1; 204USE REPORT, C93005F_PK1; 205WITH SYSTEM; USE SYSTEM; 206PROCEDURE C93005F IS 207 208 209BEGIN 210 211 TEST("C93005F", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " & 212 "TASKS"); 213 214 COMMENT("SUBTEST 4: TASK IN STATEMENT PART OF BLOCK"); 215 COMMENT(" THE TASKS DEPEND ON THE DECLARATIVE PART"); 216B41: DECLARE 217 X : MNT; 218 BEGIN 219B42: DECLARE 220 TYPE LOCAL_ACC IS ACCESS BAD_REC; 221 Y : MNT; 222 PTR : LOCAL_ACC; 223 224 TYPE ACC_MNT IS ACCESS MNT; 225 Z : ACC_MNT; 226 227 BEGIN 228 Z := NEW MNT; 229 PTR := NEW BAD_REC; 230 IF PTR.I /= REPORT.IDENT_INT(0) THEN 231 FAILED ("EXCEPTION NOT RAISED, VALUE CHANGED"); 232 ELSE 233 FAILED ("EXCEPTION NOT RAISED, CONSTRAINT IGNORED"); 234 END IF; 235 EXCEPTION 236 WHEN CONSTRAINT_ERROR => NULL; 237 WHEN OTHERS => 238 FAILED ("WRONG EXCEPTION IN B42"); 239 END B42; 240 241 COMMENT("SUBTEST 4: COMPLETED"); 242 EXCEPTION 243 WHEN OTHERS => 244 FAILED ("EXCEPTION NOT ABSORBED"); 245 END B41; 246 247 CHECK; 248 249 RESULT; 250 251EXCEPTION 252 WHEN OTHERS => 253 FAILED ("EXCEPTION NOT ABSORBED"); 254 RESULT; 255END C93005F; 256