URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c85006a.ada] - Blame information for rev 399

Go to most recent revision | Details | Compare with Previous | View Log


-- C85006A.ADA
 
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
-- OBJECTIVE:
--     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY AN
--     OBJECT DECLARATION CAN BE RENAMED AND HAS THE CORRECT VALUE,
--     AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT
--     AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
--     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
--     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
--     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
 
-- HISTORY:
--     JET 03/22/88  CREATED ORIGINAL TEST.
 
WITH REPORT; USE REPORT;
PROCEDURE C85006A IS
 
     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
     TYPE RECORD1 (D : INTEGER) IS
          RECORD
               FIELD1 : INTEGER := 1;
          END RECORD;
     TYPE POINTER1 IS ACCESS INTEGER;
 
     PACKAGE PACK1 IS
          TYPE PRIVY IS PRIVATE;
          ZERO : CONSTANT PRIVY;
          ONE : CONSTANT PRIVY;
          TWO : CONSTANT PRIVY;
          THREE : CONSTANT PRIVY;
          FOUR : CONSTANT PRIVY;
          FIVE : CONSTANT PRIVY;
          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
     PRIVATE
          TYPE PRIVY IS RANGE 0..127;
          ZERO : CONSTANT PRIVY := 0;
          ONE : CONSTANT PRIVY := 1;
          TWO : CONSTANT PRIVY := 2;
          THREE : CONSTANT PRIVY := 3;
          FOUR : CONSTANT PRIVY := 4;
          FIVE : CONSTANT PRIVY := 5;
     END PACK1;
 
     TASK TYPE TASK1 IS
          ENTRY ASSIGN (J : IN INTEGER);
          ENTRY VALU (J : OUT INTEGER);
          ENTRY NEXT;
          ENTRY STOP;
     END TASK1;
 
     TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
     TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
     TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
     TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
     TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
     TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
 
     TASK TYPE TASK2 IS
          ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
                        TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
                        TRV1 : IN OUT PACK1.PRIVY; TRT1 : IN OUT TASK1;
                        TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
                        TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
                        TAV1 : IN OUT ARR_PVT; TAT1 : IN OUT ARR_TSK);
     END TASK2;
 
     TYPE REC_TYPE IS RECORD
          RI1 : INTEGER := 0;
          RA1 : ARRAY1(1..3) := (OTHERS => 0);
          RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
          RP1 : POINTER1 := NEW INTEGER'(0);
          RV1 : PACK1.PRIVY := PACK1.ZERO;
          RT1 : TASK1;
     END RECORD;
 
     REC : REC_TYPE;
 
     AI1 : ARR_INT(1..8) := (OTHERS => 0);
     AA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
     AR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
     AP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
     AV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
     AT1 : ARR_TSK(1..8);
 
     XRI1 : INTEGER RENAMES REC.RI1;
     XRA1 : ARRAY1 RENAMES REC.RA1;
     XRR1 : RECORD1 RENAMES REC.RR1;
     XRP1 : POINTER1 RENAMES REC.RP1;
     XRV1 : PACK1.PRIVY RENAMES REC.RV1;
     XRT1 : TASK1 RENAMES REC.RT1;
     XAI1 : ARR_INT RENAMES AI1(1..3);
     XAA1 : ARR_ARR RENAMES AA1(2..4);
     XAR1 : ARR_REC RENAMES AR1(3..5);
     XAP1 : ARR_PTR RENAMES AP1(4..6);
     XAV1 : ARR_PVT RENAMES AV1(5..7);
     XAT1 : ARR_TSK RENAMES AT1(6..8);
 
     I : INTEGER;
     CHK_TASK : TASK2;
 
     GENERIC
          GRI1 : IN OUT INTEGER;
          GRA1 : IN OUT ARRAY1;
          GRR1 : IN OUT RECORD1;
          GRP1 : IN OUT POINTER1;
          GRV1 : IN OUT PACK1.PRIVY;
          GRT1 : IN OUT TASK1;
          GAI1 : IN OUT ARR_INT;
          GAA1 : IN OUT ARR_ARR;
          GAR1 : IN OUT ARR_REC;
          GAP1 : IN OUT ARR_PTR;
          GAV1 : IN OUT ARR_PVT;
          GAT1 : IN OUT ARR_TSK;
     PACKAGE GENERIC1 IS
     END GENERIC1;
 
     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
     BEGIN
          IF EQUAL (3,3) THEN
               RETURN P;
          ELSE
               RETURN NULL;
          END IF;
     END IDENT;
 
     PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
                      PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
                      PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
                      PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
                      PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
                      PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
 
     BEGIN
          PRI1 := PRI1 + 1;
          PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
          PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
          PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
          PRV1 := PACK1.NEXT(REC.RV1);
          PRT1.NEXT;
          PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
          PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
          PAR1 := (OTHERS => (D => 1,
                              FIELD1 => (PAR1(PAR1'FIRST).FIELD1 + 1)));
          PAP1 := (OTHERS => NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
          FOR J IN PAV1'RANGE LOOP
               PAV1(J) := PACK1.NEXT(AV1(J));
          END LOOP;
          FOR J IN PAT1'RANGE LOOP
               PAT1(J).NEXT;
          END LOOP;
     END PROC1;
 
     PACKAGE BODY PACK1 IS
          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
          BEGIN
               IF EQUAL(3,3) THEN
                    RETURN I;
               ELSE
                    RETURN PRIVY'(0);
               END IF;
          END IDENT;
 
          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
          BEGIN
               RETURN I+1;
          END NEXT;
     END PACK1;
 
     PACKAGE BODY GENERIC1 IS
     BEGIN
          GRI1 := GRI1 + 1;
          GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
          GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
          GRP1 := NEW INTEGER'(GRP1.ALL + 1);
          GRV1 := PACK1.NEXT(GRV1);
          GRT1.NEXT;
          GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
          GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
          GAR1 := (OTHERS => (D => 1,
                              FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
          GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
          FOR J IN GAV1'RANGE LOOP
               GAV1(J) := PACK1.NEXT(GAV1(J));
          END LOOP;
          FOR J IN GAT1'RANGE LOOP
               GAT1(J).NEXT;
          END LOOP;
     END GENERIC1;
 
     TASK BODY TASK1 IS
          TASK_VALUE : INTEGER := 0;
          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
     BEGIN
          WHILE ACCEPTING_ENTRIES LOOP
               SELECT
                    ACCEPT ASSIGN (J : IN INTEGER) DO
                         TASK_VALUE := J;
                    END ASSIGN;
               OR
                    ACCEPT VALU (J : OUT INTEGER) DO
                         J := TASK_VALUE;
                    END VALU;
               OR
                    ACCEPT NEXT DO
                         TASK_VALUE := TASK_VALUE + 1;
                    END NEXT;
               OR
                    ACCEPT STOP DO
                         ACCEPTING_ENTRIES := FALSE;
                    END STOP;
               END SELECT;
          END LOOP;
     END TASK1;
 
     TASK BODY TASK2 IS
     BEGIN
          ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
                         TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
                         TRV1 : IN OUT PACK1.PRIVY; TRT1: IN OUT TASK1;
                         TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
                         TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
                         TAV1 : IN OUT ARR_PVT; TAT1 : IN OUT ARR_TSK)
          DO
               TRI1 := REC.RI1 + 1;
               TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
               TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
               TRP1 := NEW INTEGER'(TRP1.ALL + 1);
               TRV1 := PACK1.NEXT(TRV1);
               TRT1.NEXT;
               TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
               TAA1 := (OTHERS => (OTHERS => AA1(TAA1'FIRST)(1) + 1));
               TAR1 := (OTHERS => (D => 1,
                              FIELD1 => (AR1(TAR1'FIRST).FIELD1 + 1)));
               TAP1 := (OTHERS => NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
               FOR J IN TAV1'RANGE LOOP
                    TAV1(J) := PACK1.NEXT(TAV1(J));
               END LOOP;
               FOR J IN TAT1'RANGE LOOP
                    TAT1(J).NEXT;
               END LOOP;
          END ENTRY1;
     END TASK2;
 
BEGIN
     TEST ("C85006A", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
                      "CREATED BY AN OBJECT DECLARATION CAN BE " &
                      "RENAMED AND HAS THE CORRECT VALUE, AND THAT " &
                      "THE NEW NAME CAN BE USED IN AN ASSIGNMENT " &
                      "STATEMENT AND PASSED ON AS AN ACTUAL " &
                      "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
                      "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
                      "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
                      "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
                      "REFLECTED BY THE VALUE OF THE NEW NAME");
 
     DECLARE
          PACKAGE GENPACK1 IS NEW
               GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
                         XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
     BEGIN
          NULL;
     END;
 
     IF XRI1 /= IDENT_INT(1) THEN
          FAILED ("INCORRECT VALUE OF XRI1 (1)");
     END IF;
 
     IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
          FAILED ("INCORRECT VALUE OF XRA1 (1)");
     END IF;
 
     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
          FAILED ("INCORRECT VALUE OF XRR1 (1)");
     END IF;
 
     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
          FAILED ("INCORRECT VALUE OF XRP1 (1)");
     END IF;
 
     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
          FAILED ("INCORRECT VALUE OF XRV1 (1)");
     END IF;
 
     XRT1.VALU(I);
     IF I /= IDENT_INT(1) THEN
          FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
     END IF;
 
     FOR J IN XAI1'RANGE LOOP
          IF XAI1(J) /= IDENT_INT(1) THEN
               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
                       ") (1)");
          END IF;
     END LOOP;
 
     FOR J IN XAA1'RANGE LOOP
          IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
                       ") (1)");
          END IF;
     END LOOP;
 
     FOR J IN XAR1'RANGE LOOP
          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
                       ") (1)");
          END IF;
     END LOOP;
 
     FOR J IN XAP1'RANGE LOOP
          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(1)
          THEN
               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
                       ") (1)");
          END IF;
     END LOOP;
 
     FOR J IN XAV1'RANGE LOOP
          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
                       ") (1)");
          END IF;
     END LOOP;
 
     FOR J IN XAT1'RANGE LOOP
          XAT1(J).VALU(I);
          IF I /= IDENT_INT(1) THEN
               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
                       INTEGER'IMAGE(J) & ").VALU (1)");
          END IF;
     END LOOP;
 
     PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
            XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
 
     IF XRI1 /= IDENT_INT(2) THEN
          FAILED ("INCORRECT VALUE OF XRI1 (2)");
     END IF;
 
     IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
          FAILED ("INCORRECT VALUE OF XRA1 (2)");
     END IF;
 
     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
          FAILED ("INCORRECT VALUE OF XRR1 (2)");
     END IF;
 
     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
          FAILED ("INCORRECT VALUE OF XRP1 (2)");
     END IF;
 
     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
          FAILED ("INCORRECT VALUE OF XRV1 (2)");
     END IF;
 
     XRT1.VALU(I);
     IF I /= IDENT_INT(2) THEN
          FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
     END IF;
 
     FOR J IN XAI1'RANGE LOOP
          IF XAI1(J) /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
                       ") (2)");
          END IF;
     END LOOP;
 
     FOR J IN XAA1'RANGE LOOP
          IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
                       ") (2)");
          END IF;
     END LOOP;
 
     FOR J IN XAR1'RANGE LOOP
          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
                       ") (2)");
          END IF;
     END LOOP;
 
     FOR J IN XAP1'RANGE LOOP
          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(2)
          THEN
               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
                       ") (2)");
          END IF;
     END LOOP;
 
     FOR J IN XAV1'RANGE LOOP
          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
                       ") (2)");
          END IF;
     END LOOP;
 
     FOR J IN XAT1'RANGE LOOP
          XAT1(J).VALU(I);
          IF I /= IDENT_INT(2) THEN
               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
                       INTEGER'IMAGE(J) & ").VALU (2)");
          END IF;
     END LOOP;
 
     CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
                     XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
 
     IF XRI1 /= IDENT_INT(3) THEN
          FAILED ("INCORRECT VALUE OF XRI1 (3)");
     END IF;
 
     IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
          FAILED ("INCORRECT VALUE OF XRA1 (3)");
     END IF;
 
     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
          FAILED ("INCORRECT VALUE OF XRR1 (3)");
     END IF;
 
     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
          FAILED ("INCORRECT VALUE OF XRP1 (3)");
     END IF;
 
     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
          FAILED ("INCORRECT VALUE OF XRV1 (3)");
     END IF;
 
     XRT1.VALU(I);
     IF I /= IDENT_INT(3) THEN
          FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
     END IF;
 
     FOR J IN XAI1'RANGE LOOP
          IF XAI1(J) /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
                       ") (3)");
          END IF;
     END LOOP;
 
     FOR J IN XAA1'RANGE LOOP
          IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
                       ") (3)");
          END IF;
     END LOOP;
 
     FOR J IN XAR1'RANGE LOOP
          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
                       ") (3)");
          END IF;
     END LOOP;
 
     FOR J IN XAP1'RANGE LOOP
          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(3)
          THEN
               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
                       ") (3)");
          END IF;
     END LOOP;
 
     FOR J IN XAV1'RANGE LOOP
          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
                       ") (3)");
          END IF;
     END LOOP;
 
     FOR J IN XAT1'RANGE LOOP
          XAT1(J).VALU(I);
          IF I /= IDENT_INT(3) THEN
               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
                       INTEGER'IMAGE(J) & ").VALU (3)");
          END IF;
     END LOOP;
 
     XRI1 := XRI1 + 1;
     XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
     XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
     XRP1 := NEW INTEGER'(XRP1.ALL + 1);
     XRV1 := PACK1.NEXT(XRV1);
     XRT1.NEXT;
     XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
     XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
     XAR1 := (OTHERS => (D => 1,
                         FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
     XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
     FOR J IN XAV1'RANGE LOOP
          XAV1(J) := PACK1.NEXT(XAV1(J));
     END LOOP;
     FOR J IN XAT1'RANGE LOOP
          XAT1(J).NEXT;
     END LOOP;
 
     IF XRI1 /= IDENT_INT(4) THEN
          FAILED ("INCORRECT VALUE OF XRI1 (4)");
     END IF;
 
     IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
          FAILED ("INCORRECT VALUE OF XRA1 (4)");
     END IF;
 
     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
          FAILED ("INCORRECT VALUE OF XRR1 (4)");
     END IF;
 
     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
          FAILED ("INCORRECT VALUE OF XRP1 (4)");
     END IF;
 
     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
          FAILED ("INCORRECT VALUE OF XRV1 (4)");
     END IF;
 
     XRT1.VALU(I);
     IF I /= IDENT_INT(4) THEN
          FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
     END IF;
 
     FOR J IN XAI1'RANGE LOOP
          IF XAI1(J) /= IDENT_INT(4) THEN
               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
                       ") (4)");
          END IF;
     END LOOP;
 
     FOR J IN XAA1'RANGE LOOP
          IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
                       ") (4)");
          END IF;
     END LOOP;
 
     FOR J IN XAR1'RANGE LOOP
          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
                       ") (4)");
          END IF;
     END LOOP;
 
     FOR J IN XAP1'RANGE LOOP
          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(4)
          THEN
               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
                       ") (4)");
          END IF;
     END LOOP;
 
     FOR J IN XAV1'RANGE LOOP
          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
                       ") (4)");
          END IF;
     END LOOP;
 
     FOR J IN XAT1'RANGE LOOP
          XAT1(J).VALU(I);
          IF I /= IDENT_INT(4) THEN
               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
                       INTEGER'IMAGE(J) & ").VALU (4)");
          END IF;
     END LOOP;
 
     REC.RI1 := REC.RI1 + 1;
     REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
     REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
     REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
     REC.RV1 := PACK1.NEXT(REC.RV1);
     REC.RT1.NEXT;
     AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
     AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
     AR1 := (OTHERS => (D => 1,
                        FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
     AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
     FOR J IN XAV1'RANGE LOOP
          AV1(J) := PACK1.NEXT(AV1(J));
     END LOOP;
     FOR J IN XAT1'RANGE LOOP
          AT1(J).NEXT;
     END LOOP;
 
     IF XRI1 /= IDENT_INT(5) THEN
          FAILED ("INCORRECT VALUE OF XRI1 (5)");
     END IF;
 
     IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
          FAILED ("INCORRECT VALUE OF XRA1 (5)");
     END IF;
 
     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
          FAILED ("INCORRECT VALUE OF XRR1 (5)");
     END IF;
 
     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
          FAILED ("INCORRECT VALUE OF XRP1 (5)");
     END IF;
 
     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
          FAILED ("INCORRECT VALUE OF XRV1 (5)");
     END IF;
 
     XRT1.VALU(I);
     IF I /= IDENT_INT(5) THEN
          FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
     END IF;
 
     FOR J IN XAI1'RANGE LOOP
          IF XAI1(J) /= IDENT_INT(5) THEN
               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
                       ") (5)");
          END IF;
     END LOOP;
 
     FOR J IN XAA1'RANGE LOOP
          IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
                       ") (5)");
          END IF;
     END LOOP;
 
     FOR J IN XAR1'RANGE LOOP
          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
                       ") (5)");
          END IF;
     END LOOP;
 
     FOR J IN XAP1'RANGE LOOP
          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(5)
          THEN
               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
                       ") (5)");
          END IF;
     END LOOP;
 
     FOR J IN XAV1'RANGE LOOP
          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
                       ") (5)");
          END IF;
     END LOOP;
 
     FOR J IN XAT1'RANGE LOOP
          XAT1(J).VALU(I);
          IF I /= IDENT_INT(5) THEN
               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
                       INTEGER'IMAGE(J) & ").VALU (5)");
          END IF;
     END LOOP;
 
     REC.RT1.STOP;
 
     FOR I IN AT1'RANGE LOOP
          AT1(I).STOP;
     END LOOP;
 
     RESULT;
END C85006A;

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c85006a.ada] - Blame information for rev 399

Line No.	Rev	Author	Line
1	294	jeremybenn	`-- 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;`