1-- C94007A.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-- OBJECTIVE: 26-- CHECK THAT A TASK THAT IS DECLARED IN A NON-LIBRARY PACKAGE 27-- (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE, 28-- BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY, 29-- OR TASK BODY. 30-- SUBTESTS ARE: 31-- (A) A SIMPLE TASK OBJECT, IN A VISIBLE PART, IN A BLOCK. 32-- (B) AN ARRAY OF TASK OBJECT, IN A PRIVATE PART, IN A FUNCTION. 33-- (C) AN ARRAY OF RECORD OF TASK OBJECT, IN A PACKAGE BODY, 34-- IN A TASK BODY. 35 36-- HISTORY: 37-- JRK 10/13/81 38-- SPS 11/21/82 39-- DHH 09/07/88 REVISED HEADER, ADDED EXCEPTION HANDLERS ON OUTER 40-- BLOCKS, AND ADDED CASE TO INSURE THAT LEAVING A 41-- PACKAGE VIA AN EXCEPTION WOULD NOT ABORT TASKS. 42-- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X. 43 44with Impdef; 45WITH REPORT; USE REPORT; 46WITH SYSTEM; USE SYSTEM; 47PROCEDURE C94007A IS 48 49 TASK TYPE SYNC IS 50 ENTRY ID (C : CHARACTER); 51 ENTRY INNER; 52 ENTRY OUTER; 53 END SYNC; 54 55 TASK BODY SYNC IS 56 ID_C : CHARACTER; 57 BEGIN 58 ACCEPT ID (C : CHARACTER) DO 59 ID_C := C; 60 END ID; 61 DELAY 1.0 * Impdef.One_Second; 62 SELECT 63 ACCEPT OUTER; 64 OR 65 DELAY 120.0 * Impdef.One_Second; 66 FAILED ("PROBABLY BLOCKED - (" & ID_C & ')'); 67 END SELECT; 68 ACCEPT INNER; 69 END SYNC; 70 71 72BEGIN 73 TEST ("C94007A", "CHECK THAT A TASK THAT IS DECLARED IN A " & 74 "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " & 75 "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " & 76 "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " & 77 "BODY, OR TASK BODY"); 78 79 -------------------------------------------------- 80 81 DECLARE -- (A) 82 83 S : SYNC; 84 85 BEGIN -- (A) 86 87 S.ID ('A'); 88 89 DECLARE 90 91 PACKAGE PKG IS 92 TASK T IS 93 ENTRY E; 94 END T; 95 END PKG; 96 97 PACKAGE BODY PKG IS 98 TASK BODY T IS 99 BEGIN 100 S.INNER; -- PROBABLE INNER BLOCK POINT. 101 END T; 102 END PKG; -- PROBABLE OUTER BLOCK POINT. 103 104 BEGIN 105 106 S.OUTER; 107 108 EXCEPTION 109 WHEN TASKING_ERROR => NULL; 110 END; 111 112 EXCEPTION 113 WHEN OTHERS => 114 FAILED("UNEXPECTED EXCEPTION RAISED - A"); 115 END; -- (A) 116 117 -------------------------------------------------- 118 119 DECLARE -- (B) 120 121 S : SYNC; 122 123 I : INTEGER; 124 125 FUNCTION F RETURN INTEGER IS 126 127 PACKAGE PKG IS 128 PRIVATE 129 TASK TYPE TT IS 130 ENTRY E; 131 END TT; 132 A : ARRAY (1..1) OF TT; 133 END PKG; 134 135 PACKAGE BODY PKG IS 136 TASK BODY TT IS 137 BEGIN 138 S.INNER; -- PROBABLE INNER BLOCK POINT. 139 END TT; 140 END PKG; -- PROBABLE OUTER BLOCK POINT. 141 142 BEGIN -- F 143 144 S.OUTER; 145 RETURN 0; 146 147 EXCEPTION 148 WHEN TASKING_ERROR => RETURN 0; 149 END F; 150 151 BEGIN -- (B) 152 153 S.ID ('B'); 154 I := F; 155 156 EXCEPTION 157 WHEN OTHERS => 158 FAILED("UNEXPECTED EXCEPTION RAISED - B"); 159 160 END; -- (B) 161 162 -------------------------------------------------- 163 164 DECLARE -- (C) 165 166 S : SYNC; 167 168 BEGIN -- (C) 169 170 S.ID ('C'); 171 172 DECLARE 173 174 TASK TSK IS 175 END TSK; 176 177 TASK BODY TSK IS 178 179 PACKAGE PKG IS 180 END PKG; 181 182 PACKAGE BODY PKG IS 183 TASK TYPE TT IS 184 ENTRY E; 185 END TT; 186 187 TYPE RT IS 188 RECORD 189 T : TT; 190 END RECORD; 191 192 AR : ARRAY (1..1) OF RT; 193 194 TASK BODY TT IS 195 BEGIN 196 S.INNER; -- PROBABLE INNER BLOCK POINT. 197 END TT; 198 END PKG; -- PROBABLE OUTER BLOCK POINT. 199 200 BEGIN -- TSK 201 202 S.OUTER; 203 204 EXCEPTION 205 WHEN TASKING_ERROR => NULL; 206 END TSK; 207 208 BEGIN 209 NULL; 210 END; 211 212 EXCEPTION 213 WHEN OTHERS => 214 FAILED("UNEXPECTED EXCEPTION RAISED - C"); 215 END; -- (C) 216 217 -------------------------------------------------- 218 219 DECLARE -- (D) 220 221 GLOBAL : INTEGER := IDENT_INT(5); 222 223 BEGIN -- (D) 224 225 DECLARE 226 227 PACKAGE PKG IS 228 TASK T IS 229 ENTRY E; 230 END T; 231 232 TASK T1 IS 233 END T1; 234 END PKG; 235 236 PACKAGE BODY PKG IS 237 TASK BODY T IS 238 BEGIN 239 ACCEPT E DO 240 RAISE CONSTRAINT_ERROR; 241 END E; 242 END T; 243 244 TASK BODY T1 IS 245 BEGIN 246 DELAY 120.0 * Impdef.One_Second; 247 GLOBAL := IDENT_INT(1); 248 END T1; 249 250 BEGIN 251 T.E; 252 253 END PKG; 254 USE PKG; 255 BEGIN 256 NULL; 257 END; 258 259 EXCEPTION 260 WHEN CONSTRAINT_ERROR => 261 IF GLOBAL /= IDENT_INT(1) THEN 262 FAILED("TASK NOT COMPLETED"); 263 END IF; 264 265 WHEN OTHERS => 266 FAILED("UNEXPECTED EXCEPTION RAISED - D"); 267 END; -- (D) 268 269 RESULT; 270END C94007A; 271