1-- C93003A.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 ACTIVATION OF TASKS CREATED BY ALLOCATORS PRESENT IN A 26-- DECLARATIVE PART TAKES PLACE DURING ELABORATION OF THE 27-- CORRESPONDING DECLARATION. 28-- SUBTESTS ARE: 29-- (A) A SIMPLE TASK ALLOCATOR, IN A BLOCK. 30-- (B) AN ARRAY OF TASK ALLOCATOR, IN A FUNCTION. 31-- (C) A RECORD OF TASK ALLOCATOR, IN A PACKAGE SPECIFICATION. 32-- (D) A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY. 33-- (E) AN ARRAY OF RECORD OF TASK ALLOCATOR, IN A TASK BODY. 34 35-- JRK 9/28/81 36-- SPS 11/11/82 37-- SPS 11/21/82 38-- RJW 8/4/86 ADDED CHECKS ON INITIALIZATIONS OF NON-TASK COMPONENTS 39-- OF RECORD TYPES. 40-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X. 41 42WITH REPORT; USE REPORT; 43WITH SYSTEM; USE SYSTEM; 44PROCEDURE C93003A IS 45 46 GLOBAL : INTEGER; 47 48 FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS 49 BEGIN 50 GLOBAL := IDENT_INT (I); 51 RETURN 0; 52 END SIDE_EFFECT; 53 54 TASK TYPE TT IS 55 ENTRY E; 56 END TT; 57 58 TASK BODY TT IS 59 I : INTEGER := SIDE_EFFECT (1); 60 BEGIN 61 NULL; 62 END TT; 63 64 65BEGIN 66 TEST ("C93003A", "CHECK THAT ACTIVATION OF TASKS CREATED BY " & 67 "ALLOCATORS PRESENT IN A DECLARATIVE PART " & 68 "TAKES PLACE DURING ELABORATION OF THE " & 69 "CORRESPONDING DECLARATION"); 70 71 -------------------------------------------------- 72 73 GLOBAL := IDENT_INT (0); 74 75 DECLARE -- (A) 76 77 TYPE A IS ACCESS TT; 78 T1 : A := NEW TT; 79 I1 : INTEGER := GLOBAL; 80 J : INTEGER := SIDE_EFFECT (0); 81 T2 : A := NEW TT; 82 I2 : INTEGER := GLOBAL; 83 84 BEGIN -- (A) 85 86 IF I1 /= 1 OR I2 /= 1 THEN 87 FAILED ("A SIMPLE TASK ALLOCATOR IN A BLOCK WAS " & 88 "ACTIVATED TOO LATE - (A)"); 89 END IF; 90 91 END; -- (A) 92 93 -------------------------------------------------- 94 95 GLOBAL := IDENT_INT (0); 96 97 DECLARE -- (B) 98 99 J : INTEGER; 100 101 FUNCTION F RETURN INTEGER IS 102 103 TYPE A_T IS ARRAY (1 .. 1) OF TT; 104 TYPE A IS ACCESS A_T; 105 A1 : A := NEW A_T; 106 I1 : INTEGER := GLOBAL; 107 J : INTEGER := SIDE_EFFECT (0); 108 A2 : A := NEW A_T; 109 I2 : INTEGER := GLOBAL; 110 111 BEGIN 112 IF I1 /= 1 OR I2 /= 1 THEN 113 FAILED ("AN ARRAY OF TASK ALLOCATOR IN A " & 114 "FUNCTION WAS ACTIVATED TOO LATE - (B)"); 115 END IF; 116 RETURN 0; 117 END F; 118 119 BEGIN -- (B) 120 121 J := F ; 122 123 END; -- (B) 124 125 -------------------------------------------------- 126 127 GLOBAL := IDENT_INT (0); 128 129 DECLARE -- (C1) 130 131 PACKAGE P IS 132 133 TYPE INTREC IS 134 RECORD 135 N1 : INTEGER := GLOBAL; 136 END RECORD; 137 138 TYPE RT IS 139 RECORD 140 M : INTEGER := GLOBAL; 141 T : TT; 142 N : INTREC; 143 END RECORD; 144 145 TYPE A IS ACCESS RT; 146 147 R1 : A := NEW RT; 148 I1 : INTEGER := GLOBAL; 149 J : INTEGER := SIDE_EFFECT (0); 150 R2 : A := NEW RT; 151 I2 : INTEGER := GLOBAL; 152 153 END P; 154 155 BEGIN -- (C1) 156 157 IF P.R1.M /= 0 OR P.R1.N.N1 /= 0 THEN 158 FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " & 159 "INITIALIZED BEFORE TASK ACTIVATED - (C1)" ); 160 END IF; 161 162 IF P.R2.M /= 0 OR P.R2.N.N1 /= 0 THEN 163 FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " & 164 "INITIALIZED BEFORE TASK ACTIVATED - (C1)" ); 165 END IF; 166 167 IF P.I1 /= 1 OR P.I2 /= 1 THEN 168 FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " & 169 "SPECIFICATION WAS ACTIVATED TOO LATE - (C1)"); 170 END IF; 171 172 END; -- (C1) 173 174 -------------------------------------------------- 175 176 GLOBAL := IDENT_INT (0); 177 178 DECLARE -- (C2) 179 180 PACKAGE Q IS 181 J1 : INTEGER; 182 PRIVATE 183 184 TYPE GRADE IS (GOOD, FAIR, POOR); 185 186 TYPE REC (G : GRADE) IS 187 RECORD 188 NULL; 189 END RECORD; 190 191 TYPE ACCR IS ACCESS REC; 192 193 TYPE ACCI IS ACCESS INTEGER; 194 195 TYPE RT IS 196 RECORD 197 M : ACCR := NEW REC (GRADE'VAL (GLOBAL)); 198 T : TT; 199 N : ACCI := NEW INTEGER'(GLOBAL); 200 END RECORD; 201 202 TYPE A IS ACCESS RT; 203 204 R1 : A := NEW RT; 205 I1 : INTEGER := GLOBAL; 206 J2 : INTEGER := SIDE_EFFECT (0); 207 R2 : A := NEW RT; 208 I2 : INTEGER := GLOBAL; 209 210 END Q; 211 212 PACKAGE BODY Q IS 213 BEGIN 214 IF R1.M.G /= GOOD OR R1.N.ALL /= 0 THEN 215 FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " & 216 "INITIALIZED BEFORE TASK ACTIVATED " & 217 "- (C2)" ); 218 END IF; 219 220 IF R2.M.G /= GOOD OR R2.N.ALL /= 0 THEN 221 FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " & 222 "INITIALIZED BEFORE TASK ACTIVATED " & 223 "- (C2)" ); 224 END IF; 225 226 IF I1 /= 1 OR I2 /= 1 THEN 227 FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " & 228 "SPECIFICATION WAS ACTIVATED TOO LATE " & 229 "- (C2)"); 230 END IF; 231 END Q; 232 233 BEGIN -- (C2) 234 235 NULL; 236 237 END; -- (C2) 238 239 -------------------------------------------------- 240 241 GLOBAL := IDENT_INT (0); 242 243 DECLARE -- (D) 244 245 PACKAGE P IS 246 247 TYPE ARR IS ARRAY (1 .. 1) OF TT; 248 TYPE INTARR IS ARRAY (1 .. 1) OF INTEGER; 249 250 TYPE RAT IS 251 RECORD 252 M : INTARR := (1 => GLOBAL); 253 A : ARR; 254 N : INTARR := (1 => GLOBAL); 255 END RECORD; 256 END P; 257 258 PACKAGE BODY P IS 259 260 TYPE A IS ACCESS RAT; 261 262 RA1 : A := NEW RAT; 263 I1 : INTEGER := GLOBAL; 264 J : INTEGER := SIDE_EFFECT (0); 265 RA2 : A := NEW RAT; 266 I2 : INTEGER := GLOBAL; 267 268 BEGIN 269 IF RA1.M (1) /= 0 OR RA1.N (1) /= 0 THEN 270 FAILED ("NON-TASK COMPONENTS OF RECORD RA1 NOT " & 271 "INITIALIZED BEFORE TASK ACTIVATED " & 272 "- (D)" ); 273 END IF; 274 275 IF RA2.M (1) /= 0 OR RA2.N (1) /= 0 THEN 276 FAILED ("NON-TASK COMPONENTS OF RECORD RA2 NOT " & 277 "INITIALIZED BEFORE TASK ACTIVATED " & 278 "- (D)" ); 279 END IF; 280 281 IF I1 /= 1 OR I2 /= 1 THEN 282 FAILED ("A RECORD OF ARRAY OF TASK ALLOCATOR IN " & 283 "A PACKAGE BODY WAS ACTIVATED " & 284 "TOO LATE - (D)"); 285 END IF; 286 END P; 287 288 BEGIN -- (D) 289 290 NULL; 291 292 END; -- (D) 293 294 -------------------------------------------------- 295 296 GLOBAL := IDENT_INT (0); 297 298 DECLARE -- (E) 299 300 TASK T IS 301 ENTRY E; 302 END T; 303 304 TASK BODY T IS 305 TYPE RT IS 306 RECORD 307 M : BOOLEAN := BOOLEAN'VAL (GLOBAL); 308 T : TT; 309 N : CHARACTER := CHARACTER'VAL (GLOBAL); 310 END RECORD; 311 312 TYPE ART IS ARRAY (1 .. 1) OF RT; 313 TYPE A IS ACCESS ART; 314 315 AR1 : A := NEW ART; 316 I1 : INTEGER := GLOBAL; 317 J : INTEGER := SIDE_EFFECT (0); 318 AR2 : A := NEW ART; 319 I2 : INTEGER := GLOBAL; 320 321 BEGIN 322 IF AR1.ALL (1).M /= FALSE OR 323 AR1.ALL (1).N /= ASCII.NUL THEN 324 FAILED ("NON-TASK COMPONENTS OF RECORD AR1 NOT " & 325 "INITIALIZED BEFORE TASK ACTIVATED " & 326 "- (E)" ); 327 END IF; 328 329 IF AR2.ALL (1).M /= FALSE OR 330 AR2.ALL (1).N /= ASCII.NUL THEN 331 FAILED ("NON-TASK COMPONENTS OF RECORD AR2 NOT " & 332 "INITIALIZED BEFORE TASK ACTIVATED " & 333 "- (E)" ); 334 END IF; 335 336 IF I1 /= 1 OR I2 /= 1 THEN 337 FAILED ("AN ARRAY OF RECORD OF TASK ALLOCATOR IN " & 338 "A TASK BODY WAS ACTIVATED TOO LATE - (E)"); 339 END IF; 340 END T; 341 342 BEGIN -- (E) 343 344 NULL; 345 346 END; -- (E) 347 348 -------------------------------------------------- 349 350 RESULT; 351END C93003A; 352