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