gcc/testsuite/ada/acats/tests/c8/c85006a.ada

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