gomp-20050608-branch/gcc/testsuite/ada/acats/tests/c8/c85006e.ada

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