1-- C85006C.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 COMPONENT OR SLICE OF A VARIABLE CREATED BY AN ENTRY 27-- 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE CORRECT 28-- VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT 29-- STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 30-- 'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' 31-- PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS 32-- CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME. 33 34-- HISTORY: 35-- JET 03/22/88 CREATED ORIGINAL TEST. 36 37WITH REPORT; USE REPORT; 38PROCEDURE C85006C IS 39 40 TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER; 41 TYPE RECORD1 (D : INTEGER) IS 42 RECORD 43 FIELD1 : INTEGER := 1; 44 END RECORD; 45 TYPE POINTER1 IS ACCESS INTEGER; 46 47 PACKAGE PACK1 IS 48 TYPE PRIVY IS PRIVATE; 49 ZERO : CONSTANT PRIVY; 50 ONE : CONSTANT PRIVY; 51 TWO : CONSTANT PRIVY; 52 THREE : CONSTANT PRIVY; 53 FOUR : CONSTANT PRIVY; 54 FIVE : CONSTANT PRIVY; 55 FUNCTION IDENT (I : PRIVY) RETURN PRIVY; 56 FUNCTION NEXT (I : PRIVY) RETURN PRIVY; 57 PRIVATE 58 TYPE PRIVY IS RANGE 0..127; 59 ZERO : CONSTANT PRIVY := 0; 60 ONE : CONSTANT PRIVY := 1; 61 TWO : CONSTANT PRIVY := 2; 62 THREE : CONSTANT PRIVY := 3; 63 FOUR : CONSTANT PRIVY := 4; 64 FIVE : CONSTANT PRIVY := 5; 65 END PACK1; 66 67 TASK TYPE TASK1 IS 68 ENTRY ASSIGN (J : IN INTEGER); 69 ENTRY VALU (J : OUT INTEGER); 70 ENTRY NEXT; 71 ENTRY STOP; 72 END TASK1; 73 74 TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER; 75 TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3); 76 TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1); 77 TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1; 78 TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY; 79 TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1; 80 81 TYPE REC_TYPE IS RECORD 82 RI1 : INTEGER := 0; 83 RA1 : ARRAY1(1..3) := (OTHERS => 0); 84 RR1 : RECORD1(1) := (D => 1, FIELD1 => 0); 85 RP1 : POINTER1 := NEW INTEGER'(0); 86 RV1 : PACK1.PRIVY := PACK1.ZERO; 87 RT1 : TASK1; 88 END RECORD; 89 90 DREC : REC_TYPE; 91 92 DAI1 : ARR_INT(1..8) := (OTHERS => 0); 93 DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0)); 94 DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0)); 95 DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0)); 96 DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO); 97 DAT1 : ARR_TSK(1..8); 98 99 I : INTEGER; 100 101 GENERIC 102 GRI1 : IN OUT INTEGER; 103 GRA1 : IN OUT ARRAY1; 104 GRR1 : IN OUT RECORD1; 105 GRP1 : IN OUT POINTER1; 106 GRV1 : IN OUT PACK1.PRIVY; 107 GRT1 : IN OUT TASK1; 108 GAI1 : IN OUT ARR_INT; 109 GAA1 : IN OUT ARR_ARR; 110 GAR1 : IN OUT ARR_REC; 111 GAP1 : IN OUT ARR_PTR; 112 GAV1 : IN OUT ARR_PVT; 113 GAT1 : IN OUT ARR_TSK; 114 PACKAGE GENERIC1 IS 115 END GENERIC1; 116 117 FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS 118 BEGIN 119 IF EQUAL (3,3) THEN 120 RETURN P; 121 ELSE 122 RETURN NULL; 123 END IF; 124 END IDENT; 125 126 PACKAGE BODY PACK1 IS 127 FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS 128 BEGIN 129 IF EQUAL(3,3) THEN 130 RETURN I; 131 ELSE 132 RETURN PRIVY'(0); 133 END IF; 134 END IDENT; 135 136 FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS 137 BEGIN 138 RETURN I+1; 139 END NEXT; 140 END PACK1; 141 142 PACKAGE BODY GENERIC1 IS 143 BEGIN 144 GRI1 := GRI1 + 1; 145 GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1); 146 GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1); 147 GRP1 := NEW INTEGER'(GRP1.ALL + 1); 148 GRV1 := PACK1.NEXT(GRV1); 149 GRT1.NEXT; 150 GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1); 151 GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1)); 152 GAR1 := (OTHERS => (D => 1, 153 FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1))); 154 GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1)); 155 FOR J IN GAV1'RANGE LOOP 156 GAV1(J) := PACK1.NEXT(GAV1(J)); 157 END LOOP; 158 FOR J IN GAT1'RANGE LOOP 159 GAT1(J).NEXT; 160 END LOOP; 161 END GENERIC1; 162 163 TASK BODY TASK1 IS 164 TASK_VALUE : INTEGER := 0; 165 ACCEPTING_ENTRIES : BOOLEAN := TRUE; 166 BEGIN 167 WHILE ACCEPTING_ENTRIES LOOP 168 SELECT 169 ACCEPT ASSIGN (J : IN INTEGER) DO 170 TASK_VALUE := J; 171 END ASSIGN; 172 OR 173 ACCEPT VALU (J : OUT INTEGER) DO 174 J := TASK_VALUE; 175 END VALU; 176 OR 177 ACCEPT NEXT DO 178 TASK_VALUE := TASK_VALUE + 1; 179 END NEXT; 180 OR 181 ACCEPT STOP DO 182 ACCEPTING_ENTRIES := FALSE; 183 END STOP; 184 END SELECT; 185 END LOOP; 186 END TASK1; 187 188BEGIN 189 TEST ("C85006C", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " & 190 "CREATED BY AN ENTRY 'IN OUT' FORMAL PARAMETER " & 191 "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " & 192 "THAT THE NEW NAME CAN BE USED IN AN ASSIGN" & 193 "MENT STATEMENT AND PASSED ON AS AN ACTUAL " & 194 "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " & 195 "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " & 196 "PARAMETER, AND THAT WHEN THE VALUE OF THE " & 197 "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " & 198 "REFLECTED BY THE VALUE OF THE NEW NAME"); 199 200 DECLARE 201 TASK MAIN_TASK IS 202 ENTRY START (REC : IN OUT REC_TYPE; 203 AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR; 204 AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR; 205 AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK); 206 END MAIN_TASK; 207 208 TASK BODY MAIN_TASK IS 209 BEGIN 210 ACCEPT START (REC : IN OUT REC_TYPE; 211 AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR; 212 AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR; 213 AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK) 214 DO 215 DECLARE 216 XRI1 : INTEGER RENAMES REC.RI1; 217 XRA1 : ARRAY1 RENAMES REC.RA1; 218 XRR1 : RECORD1 RENAMES REC.RR1; 219 XRP1 : POINTER1 RENAMES REC.RP1; 220 XRV1 : PACK1.PRIVY RENAMES REC.RV1; 221 XRT1 : TASK1 RENAMES REC.RT1; 222 XAI1 : ARR_INT RENAMES AI1(1..3); 223 XAA1 : ARR_ARR RENAMES AA1(2..4); 224 XAR1 : ARR_REC RENAMES AR1(3..5); 225 XAP1 : ARR_PTR RENAMES AP1(4..6); 226 XAV1 : ARR_PVT RENAMES AV1(5..7); 227 XAT1 : ARR_TSK RENAMES AT1(6..8); 228 229 TASK TYPE TASK2 IS 230 ENTRY ENTRY1 (TRI1 : OUT INTEGER; 231 TRA1 : OUT ARRAY1; 232 TRR1 : OUT RECORD1; 233 TRP1 : IN OUT POINTER1; 234 TRV1 : IN OUT PACK1.PRIVY; 235 TRT1 : IN OUT TASK1; 236 TAI1 : OUT ARR_INT; 237 TAA1 : OUT ARR_ARR; 238 TAR1 : OUT ARR_REC; 239 TAP1 : IN OUT ARR_PTR; 240 TAV1 : IN OUT ARR_PVT; 241 TAT1 : IN OUT ARR_TSK); 242 END TASK2; 243 244 CHK_TASK : TASK2; 245 246 TASK BODY TASK2 IS 247 BEGIN 248 ACCEPT ENTRY1 (TRI1 : OUT INTEGER; 249 TRA1 : OUT ARRAY1; 250 TRR1 : OUT RECORD1; 251 TRP1 : IN OUT POINTER1; 252 TRV1 : IN OUT PACK1.PRIVY; 253 TRT1: IN OUT TASK1; 254 TAI1 : OUT ARR_INT; 255 TAA1 : OUT ARR_ARR; 256 TAR1 : OUT ARR_REC; 257 TAP1 : IN OUT ARR_PTR; 258 TAV1 : IN OUT ARR_PVT; 259 TAT1 : IN OUT ARR_TSK) 260 DO 261 TRI1 := REC.RI1 + 1; 262 TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, 263 REC.RA1(3)+1); 264 TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1); 265 TRP1 := NEW INTEGER'(TRP1.ALL + 1); 266 TRV1 := PACK1.NEXT(TRV1); 267 TRT1.NEXT; 268 TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1); 269 TAA1 := (OTHERS => (OTHERS => 270 AA1(TAA1'FIRST)(1) + 1)); 271 TAR1 := (OTHERS => (D => 1, FIELD1 => 272 (AR1(TAR1'FIRST).FIELD1 + 1))); 273 TAP1 := (OTHERS => 274 NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1)); 275 FOR J IN TAV1'RANGE LOOP 276 TAV1(J) := PACK1.NEXT(TAV1(J)); 277 END LOOP; 278 FOR J IN TAT1'RANGE LOOP 279 TAT1(J).NEXT; 280 END LOOP; 281 END ENTRY1; 282 END TASK2; 283 284 PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; 285 PRA1 : IN OUT ARRAY1; 286 PRR1 : IN OUT RECORD1; 287 PRP1 : OUT POINTER1; 288 PRV1 : OUT PACK1.PRIVY; 289 PRT1 : IN OUT TASK1; 290 PAI1 : IN OUT ARR_INT; 291 PAA1 : IN OUT ARR_ARR; 292 PAR1 : IN OUT ARR_REC; 293 PAP1 : OUT ARR_PTR; 294 PAV1 : OUT ARR_PVT; 295 PAT1 : IN OUT ARR_TSK) IS 296 BEGIN 297 PRI1 := PRI1 + 1; 298 PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1); 299 PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1); 300 PRP1 := NEW INTEGER'(REC.RP1.ALL + 1); 301 PRV1 := PACK1.NEXT(REC.RV1); 302 PRT1.NEXT; 303 PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1); 304 PAA1 := (OTHERS => (OTHERS => 305 PAA1(PAA1'FIRST)(1) + 1)); 306 PAR1 := (OTHERS => (D => 1, FIELD1 => 307 (PAR1(PAR1'FIRST).FIELD1+1))); 308 PAP1 := (OTHERS => 309 NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1)); 310 FOR J IN PAV1'RANGE LOOP 311 PAV1(J) := PACK1.NEXT(AV1(J)); 312 END LOOP; 313 FOR J IN PAT1'RANGE LOOP 314 PAT1(J).NEXT; 315 END LOOP; 316 END PROC1; 317 318 PACKAGE GENPACK2 IS NEW GENERIC1 319 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1, 320 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1); 321 322 BEGIN 323 IF XRI1 /= IDENT_INT(1) THEN 324 FAILED ("INCORRECT VALUE OF XRI1 (1)"); 325 END IF; 326 327 IF XRA1 /= (IDENT_INT(1),IDENT_INT(1), 328 IDENT_INT(1)) THEN 329 FAILED ("INCORRECT VALUE OF XRA1 (1)"); 330 END IF; 331 332 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) 333 THEN 334 FAILED ("INCORRECT VALUE OF XRR1 (1)"); 335 END IF; 336 337 IF XRP1 /= IDENT(REC.RP1) OR 338 XRP1.ALL /= IDENT_INT(1) THEN 339 FAILED ("INCORRECT VALUE OF XRP1 (1)"); 340 END IF; 341 342 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) 343 THEN 344 FAILED ("INCORRECT VALUE OF XRV1 (1)"); 345 END IF; 346 347 XRT1.VALU(I); 348 IF I /= IDENT_INT(1) THEN 349 FAILED ("INCORRECT RETURN VALUE OF " & 350 "XRT1.VALU (1)"); 351 END IF; 352 353 FOR J IN XAI1'RANGE LOOP 354 IF XAI1(J) /= IDENT_INT(1) THEN 355 FAILED ("INCORRECT VALUE OF XAI1(" & 356 INTEGER'IMAGE(J) & ") (1)"); 357 END IF; 358 END LOOP; 359 360 FOR J IN XAA1'RANGE LOOP 361 IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1), 362 IDENT_INT(1)) THEN 363 FAILED ("INCORRECT VALUE OF XAA1(" & 364 INTEGER'IMAGE(J) & ") (1)"); 365 END IF; 366 END LOOP; 367 368 FOR J IN XAR1'RANGE LOOP 369 IF XAR1(J) /= (D => 1, 370 FIELD1 => IDENT_INT(1)) THEN 371 FAILED ("INCORRECT VALUE OF XAR1(" & 372 INTEGER'IMAGE(J) & ") (1)"); 373 END IF; 374 END LOOP; 375 376 FOR J IN XAP1'RANGE LOOP 377 IF XAP1(J) /= IDENT(AP1(J)) OR 378 XAP1(J).ALL /= IDENT_INT(1) THEN 379 FAILED ("INCORRECT VALUE OF XAP1(" & 380 INTEGER'IMAGE(J) & ") (1)"); 381 END IF; 382 END LOOP; 383 384 FOR J IN XAV1'RANGE LOOP 385 IF PACK1."/=" (XAV1(J), 386 PACK1.IDENT(PACK1.ONE)) THEN 387 FAILED ("INCORRECT VALUE OF XAV1(" & 388 INTEGER'IMAGE(J) & ") (1)"); 389 END IF; 390 END LOOP; 391 392 FOR J IN XAT1'RANGE LOOP 393 XAT1(J).VALU(I); 394 IF I /= IDENT_INT(1) THEN 395 FAILED ("INCORRECT RETURN VALUE " & 396 "FROM XAT1(" & INTEGER'IMAGE(J) & 397 ").VALU (1)"); 398 END IF; 399 END LOOP; 400 401 PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1, 402 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1); 403 404 IF XRI1 /= IDENT_INT(2) THEN 405 FAILED ("INCORRECT VALUE OF XRI1 (2)"); 406 END IF; 407 408 IF XRA1 /= (IDENT_INT(2),IDENT_INT(2), 409 IDENT_INT(2)) THEN 410 FAILED ("INCORRECT VALUE OF XRA1 (2)"); 411 END IF; 412 413 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) 414 THEN 415 FAILED ("INCORRECT VALUE OF XRR1 (2)"); 416 END IF; 417 418 IF XRP1 /= IDENT(REC.RP1) OR 419 XRP1.ALL /= IDENT_INT(2) THEN 420 FAILED ("INCORRECT VALUE OF XRP1 (2)"); 421 END IF; 422 423 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) 424 THEN 425 FAILED ("INCORRECT VALUE OF XRV1 (2)"); 426 END IF; 427 428 XRT1.VALU(I); 429 IF I /= IDENT_INT(2) THEN 430 FAILED ("INCORRECT RETURN VALUE FROM " & 431 "XRT1.VALU (2)"); 432 END IF; 433 434 FOR J IN XAI1'RANGE LOOP 435 IF XAI1(J) /= IDENT_INT(2) THEN 436 FAILED ("INCORRECT VALUE OF XAI1(" & 437 INTEGER'IMAGE(J) & ") (2)"); 438 END IF; 439 END LOOP; 440 441 FOR J IN XAA1'RANGE LOOP 442 IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2), 443 IDENT_INT(2)) THEN 444 FAILED ("INCORRECT VALUE OF XAA1(" & 445 INTEGER'IMAGE(J) & ") (2)"); 446 END IF; 447 END LOOP; 448 449 FOR J IN XAR1'RANGE LOOP 450 IF XAR1(J) /= (D => 1, 451 FIELD1 => IDENT_INT(2)) THEN 452 FAILED ("INCORRECT VALUE OF XAR1(" & 453 INTEGER'IMAGE(J) & ") (2)"); 454 END IF; 455 END LOOP; 456 457 FOR J IN XAP1'RANGE LOOP 458 IF XAP1(J) /= IDENT(AP1(J)) OR 459 XAP1(J).ALL /= IDENT_INT(2) THEN 460 FAILED ("INCORRECT VALUE OF XAP1(" & 461 INTEGER'IMAGE(J) & ") (2)"); 462 END IF; 463 END LOOP; 464 465 FOR J IN XAV1'RANGE LOOP 466 IF PACK1."/=" (XAV1(J), 467 PACK1.IDENT(PACK1.TWO)) THEN 468 FAILED ("INCORRECT VALUE OF XAV1(" & 469 INTEGER'IMAGE(J) & ") (2)"); 470 END IF; 471 END LOOP; 472 473 FOR J IN XAT1'RANGE LOOP 474 XAT1(J).VALU(I); 475 IF I /= IDENT_INT(2) THEN 476 FAILED ("INCORRECT RETURN VALUE " & 477 "FROM XAT1(" & INTEGER'IMAGE(J) & 478 ").VALU (2)"); 479 END IF; 480 END LOOP; 481 482 CHK_TASK.ENTRY1 483 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1, 484 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1); 485 486 IF XRI1 /= IDENT_INT(3) THEN 487 FAILED ("INCORRECT VALUE OF XRI1 (3)"); 488 END IF; 489 490 IF XRA1 /= (IDENT_INT(3),IDENT_INT(3), 491 IDENT_INT(3)) THEN 492 FAILED ("INCORRECT VALUE OF XRA1 (3)"); 493 END IF; 494 495 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) 496 THEN 497 FAILED ("INCORRECT VALUE OF XRR1 (3)"); 498 END IF; 499 500 IF XRP1 /= IDENT(REC.RP1) OR 501 XRP1.ALL /= IDENT_INT(3) THEN 502 FAILED ("INCORRECT VALUE OF XRP1 (3)"); 503 END IF; 504 505 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) 506 THEN 507 FAILED ("INCORRECT VALUE OF XRV1 (3)"); 508 END IF; 509 510 XRT1.VALU(I); 511 IF I /= IDENT_INT(3) THEN 512 FAILED ("INCORRECT RETURN VALUE OF " & 513 "XRT1.VALU (3)"); 514 END IF; 515 516 FOR J IN XAI1'RANGE LOOP 517 IF XAI1(J) /= IDENT_INT(3) THEN 518 FAILED ("INCORRECT VALUE OF XAI1(" & 519 INTEGER'IMAGE(J) & ") (3)"); 520 END IF; 521 END LOOP; 522 523 FOR J IN XAA1'RANGE LOOP 524 IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3), 525 IDENT_INT(3)) 526 THEN 527 FAILED ("INCORRECT VALUE OF XAA1(" & 528 INTEGER'IMAGE(J) & ") (3)"); 529 END IF; 530 END LOOP; 531 532 FOR J IN XAR1'RANGE LOOP 533 IF XAR1(J) /= (D => 1, 534 FIELD1 => IDENT_INT(3)) THEN 535 FAILED ("INCORRECT VALUE OF XAR1(" & 536 INTEGER'IMAGE(J) & ") (3)"); 537 END IF; 538 END LOOP; 539 540 FOR J IN XAP1'RANGE LOOP 541 IF XAP1(J) /= IDENT(AP1(J)) OR 542 XAP1(J).ALL /= IDENT_INT(3) THEN 543 FAILED ("INCORRECT VALUE OF XAP1(" & 544 INTEGER'IMAGE(J) & ") (3)"); 545 END IF; 546 END LOOP; 547 548 FOR J IN XAV1'RANGE LOOP 549 IF PACK1."/=" (XAV1(J), 550 PACK1.IDENT(PACK1.THREE)) THEN 551 FAILED ("INCORRECT VALUE OF XAV1(" & 552 INTEGER'IMAGE(J) & ") (3)"); 553 END IF; 554 END LOOP; 555 556 FOR J IN XAT1'RANGE LOOP 557 XAT1(J).VALU(I); 558 IF I /= IDENT_INT(3) THEN 559 FAILED ("INCORRECT RETURN VALUE " & 560 "FROM XAT1(" & 561 INTEGER'IMAGE(J) & ").VALU (3)"); 562 END IF; 563 END LOOP; 564 565 XRI1 := XRI1 + 1; 566 XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1); 567 XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1); 568 XRP1 := NEW INTEGER'(XRP1.ALL + 1); 569 XRV1 := PACK1.NEXT(XRV1); 570 XRT1.NEXT; 571 XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1); 572 XAA1 := (OTHERS => 573 (OTHERS => XAA1(XAA1'FIRST)(1) + 1)); 574 XAR1 := (OTHERS => (D => 1, FIELD1 => 575 (XAR1(XAR1'FIRST).FIELD1 + 1))); 576 XAP1 := (OTHERS => 577 NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1)); 578 FOR J IN XAV1'RANGE LOOP 579 XAV1(J) := PACK1.NEXT(XAV1(J)); 580 END LOOP; 581 FOR J IN XAT1'RANGE LOOP 582 XAT1(J).NEXT; 583 END LOOP; 584 585 IF XRI1 /= IDENT_INT(4) THEN 586 FAILED ("INCORRECT VALUE OF XRI1 (4)"); 587 END IF; 588 589 IF XRA1 /= (IDENT_INT(4),IDENT_INT(4), 590 IDENT_INT(4)) THEN 591 FAILED ("INCORRECT VALUE OF XRA1 (4)"); 592 END IF; 593 594 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) 595 THEN 596 FAILED ("INCORRECT VALUE OF XRR1 (4)"); 597 END IF; 598 599 IF XRP1 /= IDENT(REC.RP1) OR 600 XRP1.ALL /= IDENT_INT(4) THEN 601 FAILED ("INCORRECT VALUE OF XRP1 (4)"); 602 END IF; 603 604 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) 605 THEN 606 FAILED ("INCORRECT VALUE OF XRV1 (4)"); 607 END IF; 608 609 XRT1.VALU(I); 610 IF I /= IDENT_INT(4) THEN 611 FAILED ("INCORRECT RETURN VALUE OF " & 612 "XRT1.VALU (4)"); 613 END IF; 614 615 FOR J IN XAI1'RANGE LOOP 616 IF XAI1(J) /= IDENT_INT(4) THEN 617 FAILED ("INCORRECT VALUE OF XAI1(" & 618 INTEGER'IMAGE(J) & ") (4)"); 619 END IF; 620 END LOOP; 621 622 FOR J IN XAA1'RANGE LOOP 623 IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4), 624 IDENT_INT(4)) THEN 625 FAILED ("INCORRECT VALUE OF XAA1(" & 626 INTEGER'IMAGE(J) & ") (4)"); 627 END IF; 628 END LOOP; 629 630 FOR J IN XAR1'RANGE LOOP 631 IF XAR1(J) /= (D => 1, FIELD1 => 632 IDENT_INT(4)) THEN 633 FAILED ("INCORRECT VALUE OF XAR1(" & 634 INTEGER'IMAGE(J) & ") (4)"); 635 END IF; 636 END LOOP; 637 638 FOR J IN XAP1'RANGE LOOP 639 IF XAP1(J) /= IDENT(AP1(J)) OR 640 XAP1(J).ALL /= IDENT_INT(4) THEN 641 FAILED ("INCORRECT VALUE OF XAP1(" & 642 INTEGER'IMAGE(J) & ") (4)"); 643 END IF; 644 END LOOP; 645 646 FOR J IN XAV1'RANGE LOOP 647 IF PACK1."/=" (XAV1(J), 648 PACK1.IDENT(PACK1.FOUR)) THEN 649 FAILED ("INCORRECT VALUE OF XAV1(" & 650 INTEGER'IMAGE(J) & ") (4)"); 651 END IF; 652 END LOOP; 653 654 FOR J IN XAT1'RANGE LOOP 655 XAT1(J).VALU(I); 656 IF I /= IDENT_INT(4) THEN 657 FAILED ("INCORRECT RETURN VALUE " & 658 "FROM XAT1(" & 659 INTEGER'IMAGE(J) & ").VALU (4)"); 660 END IF; 661 END LOOP; 662 663 REC.RI1 := REC.RI1 + 1; 664 REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, 665 REC.RA1(3)+1); 666 REC.RR1 := (D => 1, FIELD1 => 667 REC.RR1.FIELD1 + 1); 668 REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1); 669 REC.RV1 := PACK1.NEXT(REC.RV1); 670 REC.RT1.NEXT; 671 AI1(XAI1'RANGE) := (OTHERS => 672 AI1(XAI1'FIRST) + 1); 673 AA1(XAA1'RANGE) := (OTHERS => 674 (OTHERS => AA1(XAA1'FIRST)(1) + 1)); 675 AR1(XAR1'RANGE) := (OTHERS => (D => 1, 676 FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1))); 677 AP1(XAP1'RANGE) := (OTHERS => 678 NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1)); 679 FOR J IN XAV1'RANGE LOOP 680 AV1(J) := PACK1.NEXT(AV1(J)); 681 END LOOP; 682 FOR J IN XAT1'RANGE LOOP 683 AT1(J).NEXT; 684 END LOOP; 685 686 IF XRI1 /= IDENT_INT(5) THEN 687 FAILED ("INCORRECT VALUE OF XRI1 (5)"); 688 END IF; 689 690 IF XRA1 /= (IDENT_INT(5),IDENT_INT(5), 691 IDENT_INT(5)) THEN 692 FAILED ("INCORRECT VALUE OF XRA1 (5)"); 693 END IF; 694 695 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) 696 THEN 697 FAILED ("INCORRECT VALUE OF XRR1 (5)"); 698 END IF; 699 700 IF XRP1 /= IDENT(REC.RP1) OR 701 XRP1.ALL /= IDENT_INT(5) THEN 702 FAILED ("INCORRECT VALUE OF XRP1 (5)"); 703 END IF; 704 705 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) 706 THEN 707 FAILED ("INCORRECT VALUE OF XRV1 (5)"); 708 END IF; 709 710 XRT1.VALU(I); 711 IF I /= IDENT_INT(5) THEN 712 FAILED ("INCORRECT RETURN VALUE OF " & 713 "XRT1.VALU (5)"); 714 END IF; 715 716 FOR J IN XAI1'RANGE LOOP 717 IF XAI1(J) /= IDENT_INT(5) THEN 718 FAILED ("INCORRECT VALUE OF XAI1(" & 719 INTEGER'IMAGE(J) & ") (5)"); 720 END IF; 721 END LOOP; 722 723 FOR J IN XAA1'RANGE LOOP 724 IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5), 725 IDENT_INT(5)) THEN 726 FAILED ("INCORRECT VALUE OF XAA1(" & 727 INTEGER'IMAGE(J) & ") (5)"); 728 END IF; 729 END LOOP; 730 731 FOR J IN XAR1'RANGE LOOP 732 IF XAR1(J) /= (D => 1, FIELD1 => 733 IDENT_INT(5)) THEN 734 FAILED ("INCORRECT VALUE OF XAR1(" & 735 INTEGER'IMAGE(J) & ") (5)"); 736 END IF; 737 END LOOP; 738 739 FOR J IN XAP1'RANGE LOOP 740 IF XAP1(J) /= IDENT(AP1(J)) OR 741 XAP1(J).ALL /= IDENT_INT(5) THEN 742 FAILED ("INCORRECT VALUE OF XAP1(" & 743 INTEGER'IMAGE(J) & ") (5)"); 744 END IF; 745 END LOOP; 746 747 FOR J IN XAV1'RANGE LOOP 748 IF PACK1."/=" (XAV1(J), 749 PACK1.IDENT(PACK1.FIVE)) THEN 750 FAILED ("INCORRECT VALUE OF XAV1(" & 751 INTEGER'IMAGE(J) & ") (5)"); 752 END IF; 753 END LOOP; 754 755 FOR J IN XAT1'RANGE LOOP 756 XAT1(J).VALU(I); 757 IF I /= IDENT_INT(5) THEN 758 FAILED ("INCORRECT RETURN VALUE " & 759 "FROM XAT1(" & 760 INTEGER'IMAGE(J) & ").VALU (5)"); 761 END IF; 762 END LOOP; 763 END; 764 END START; 765 END MAIN_TASK; 766 767 BEGIN 768 MAIN_TASK.START (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1); 769 END; 770 771 DREC.RT1.STOP; 772 773 FOR I IN DAT1'RANGE LOOP 774 DAT1(I).STOP; 775 END LOOP; 776 777 RESULT; 778END C85006C; 779