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