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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c85005a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log


-- C85005A.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 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/15/88  CREATED ORIGINAL TEST.
 
WITH REPORT; USE REPORT;
PROCEDURE C85005A 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
          K1 : INTEGER := 0;
          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;
 
     TASK TYPE TASK2 IS
          ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
                        TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
                        TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
                        TK1 : IN OUT INTEGER);
     END TASK2;
 
     I1 : INTEGER := 0;
     A1 : ARRAY1(1..3) := (OTHERS => 0);
     R1 : RECORD1(1) := (D => 1, FIELD1 => 0);
     P1 : POINTER1 := NEW INTEGER'(0);
     V1 : PACK1.PRIVY := PACK1.ZERO;
     T1 : TASK1;
 
     XI1 : INTEGER RENAMES I1;
     XA1 : ARRAY1 RENAMES A1;
     XR1 : RECORD1 RENAMES R1;
     XP1 : POINTER1 RENAMES P1;
     XV1 : PACK1.PRIVY RENAMES V1;
     XT1 : TASK1 RENAMES T1;
     XK1 : INTEGER RENAMES PACK1.K1;
 
     I : INTEGER;
     CHK_TASK : TASK2;
 
     GENERIC
          GI1 : IN OUT INTEGER;
          GA1 : IN OUT ARRAY1;
          GR1 : IN OUT RECORD1;
          GP1 : IN OUT POINTER1;
          GV1 : IN OUT PACK1.PRIVY;
          GT1 : IN OUT TASK1;
          GK1 : IN OUT INTEGER;
     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 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
                      PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
                      PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
                      PK1 : OUT INTEGER) IS
 
     BEGIN
          PI1 := PI1 + 1;
          PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
          PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
          PP1 := NEW INTEGER'(P1.ALL + 1);
          PV1 := PACK1.NEXT(V1);
          PT1.NEXT;
          PK1 := PACK1.K1 + 1;
     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
          GI1 := GI1 + 1;
          GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
          GR1 := (D => 1, FIELD1 => GR1.FIELD1+1);
          GP1 := NEW INTEGER'(GP1.ALL + 1);
          GV1 := PACK1.NEXT(GV1);
          GT1.NEXT;
          GK1 := GK1 + 1;
     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 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
                         TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
                         TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
                         TK1 : IN OUT INTEGER) DO
 
               TI1 := I1 + 1;
               TA1 := (A1(1)+1, A1(2)+1, A1(3)+1);
               TR1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
               TP1 := NEW INTEGER'(TP1.ALL + 1);
               TV1 := PACK1.NEXT(TV1);
               TT1.NEXT;
               TK1 := TK1 + 1;
          END ENTRY1;
     END TASK2;
 
BEGIN
     TEST ("C85005A", "CHECK THAT 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 (XI1, XA1, XR1, XP1, XV1, XT1, XK1);
     BEGIN
          NULL;
     END;
 
     IF XI1 /= IDENT_INT(1) THEN
          FAILED ("INCORRECT VALUE OF XI1 (1)");
     END IF;
 
     IF XA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
          FAILED ("INCORRECT VALUE OF XA1 (1)");
     END IF;
 
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
          FAILED ("INCORRECT VALUE OF XR1 (1)");
     END IF;
 
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(1) THEN
          FAILED ("INCORRECT VALUE OF XP1 (1)");
     END IF;
 
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.ONE)) THEN
          FAILED ("INCORRECT VALUE OF XV1 (1)");
     END IF;
 
     XT1.VALU(I);
     IF I /= IDENT_INT(1) THEN
          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (1)");
     END IF;
 
     IF XK1 /= IDENT_INT(1) THEN
          FAILED ("INCORRECT VALUE OF XK1 (1)");
     END IF;
 
     PROC1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
 
     IF XI1 /= IDENT_INT(2) THEN
          FAILED ("INCORRECT VALUE OF XI1 (2)");
     END IF;
 
     IF XA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
          FAILED ("INCORRECT VALUE OF XA1 (2)");
     END IF;
 
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
          FAILED ("INCORRECT VALUE OF XR1 (2)");
     END IF;
 
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(2) THEN
          FAILED ("INCORRECT VALUE OF XP1 (2)");
     END IF;
 
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.TWO)) THEN
          FAILED ("INCORRECT VALUE OF XV1 (2)");
     END IF;
 
     XT1.VALU(I);
     IF I /= IDENT_INT(2) THEN
          FAILED ("INCORRECT RETURN VALUE FROM XT1.VALU (2)");
     END IF;
 
     IF XK1 /= IDENT_INT(2) THEN
          FAILED ("INCORRECT VALUE OF XK1 (2)");
     END IF;
 
     CHK_TASK.ENTRY1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
 
     IF XI1 /= IDENT_INT(3) THEN
          FAILED ("INCORRECT VALUE OF XI1 (3)");
     END IF;
 
     IF XA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
          FAILED ("INCORRECT VALUE OF XA1 (3)");
     END IF;
 
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
          FAILED ("INCORRECT VALUE OF XR1 (3)");
     END IF;
 
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(3) THEN
          FAILED ("INCORRECT VALUE OF XP1 (3)");
     END IF;
 
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.THREE)) THEN
          FAILED ("INCORRECT VALUE OF XV1 (3)");
     END IF;
 
     XT1.VALU(I);
     IF I /= IDENT_INT(3) THEN
          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (3)");
     END IF;
 
     IF XK1 /= IDENT_INT(3) THEN
          FAILED ("INCORRECT VALUE OF XK1 (3)");
     END IF;
 
     XI1 := XI1 + 1;
     XA1 := (XA1(1)+1, XA1(2)+1, XA1(3)+1);
     XR1 := (D => 1, FIELD1 => XR1.FIELD1 + 1);
     XP1 := NEW INTEGER'(XP1.ALL + 1);
     XV1 := PACK1.NEXT(XV1);
     XT1.NEXT;
     XK1 := XK1 + 1;
 
     IF XI1 /= IDENT_INT(4) THEN
          FAILED ("INCORRECT VALUE OF XI1 (4)");
     END IF;
 
     IF XA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
          FAILED ("INCORRECT VALUE OF XA1 (4)");
     END IF;
 
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
          FAILED ("INCORRECT VALUE OF XR1 (4)");
     END IF;
 
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(4) THEN
          FAILED ("INCORRECT VALUE OF XP1 (4)");
     END IF;
 
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FOUR)) THEN
          FAILED ("INCORRECT VALUE OF XV1 (4)");
     END IF;
 
     XT1.VALU(I);
     IF I /= IDENT_INT(4) THEN
          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (4)");
     END IF;
 
     IF XK1 /= IDENT_INT(4) THEN
          FAILED ("INCORRECT VALUE OF XK1 (4)");
     END IF;
 
     I1 := I1 + 1;
     A1 := (A1(1)+1, A1(2)+1, A1(3)+1);
     R1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
     P1 := NEW INTEGER'(P1.ALL + 1);
     V1 := PACK1.NEXT(V1);
     T1.NEXT;
     PACK1.K1 := PACK1.K1 + 1;
 
     IF XI1 /= IDENT_INT(5) THEN
          FAILED ("INCORRECT VALUE OF XI1 (5)");
     END IF;
 
     IF XA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
          FAILED ("INCORRECT VALUE OF XA1 (5)");
     END IF;
 
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
          FAILED ("INCORRECT VALUE OF XR1 (5)");
     END IF;
 
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(5) THEN
          FAILED ("INCORRECT VALUE OF XP1 (5)");
     END IF;
 
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FIVE)) THEN
          FAILED ("INCORRECT VALUE OF XV1 (5)");
     END IF;
 
     XT1.VALU(I);
     IF I /= IDENT_INT(5) THEN
          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (5)");
     END IF;
 
     IF XK1 /= IDENT_INT(5) THEN
          FAILED ("INCORRECT VALUE OF XK1 (5)");
     END IF;
 
     T1.STOP;
 
     RESULT;
END C85005A;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c85005a.ada] - Blame information for rev 720

Line No.	Rev	Author	Line
1	720	jeremybenn	`-- C85005A.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 VARIABLE CREATED BY AN OBJECT DECLARATION CAN BE`
27			`-- RENAMED AND HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN`
28			`-- BE USED IN AN ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL`
29			`-- SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN`
30			`-- ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF`
31			`-- THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED`
32			`-- BY THE VALUE OF THE NEW NAME.`
33
34			`-- HISTORY:`
35			`-- JET 03/15/88 CREATED ORIGINAL TEST.`
36
37			`WITH REPORT; USE REPORT;`
38			`PROCEDURE C85005A 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			`K1 : INTEGER := 0;`
49			`TYPE PRIVY IS PRIVATE;`
50			`ZERO : CONSTANT PRIVY;`
51			`ONE : CONSTANT PRIVY;`
52			`TWO : CONSTANT PRIVY;`
53			`THREE : CONSTANT PRIVY;`
54			`FOUR : CONSTANT PRIVY;`
55			`FIVE : CONSTANT PRIVY;`
56			`FUNCTION IDENT (I : PRIVY) RETURN PRIVY;`
57			`FUNCTION NEXT (I : PRIVY) RETURN PRIVY;`
58			`PRIVATE`
59			`TYPE PRIVY IS RANGE 0..127;`
60			`ZERO : CONSTANT PRIVY := 0;`
61			`ONE : CONSTANT PRIVY := 1;`
62			`TWO : CONSTANT PRIVY := 2;`
63			`THREE : CONSTANT PRIVY := 3;`
64			`FOUR : CONSTANT PRIVY := 4;`
65			`FIVE : CONSTANT PRIVY := 5;`
66			`END PACK1;`
67
68			`TASK TYPE TASK1 IS`
69			`ENTRY ASSIGN (J : IN INTEGER);`
70			`ENTRY VALU (J : OUT INTEGER);`
71			`ENTRY NEXT;`
72			`ENTRY STOP;`
73			`END TASK1;`
74
75			`TASK TYPE TASK2 IS`
76			`ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;`
77			`TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;`
78			`TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;`
79			`TK1 : IN OUT INTEGER);`
80			`END TASK2;`
81
82			`I1 : INTEGER := 0;`
83			`A1 : ARRAY1(1..3) := (OTHERS => 0);`
84			`R1 : RECORD1(1) := (D => 1, FIELD1 => 0);`
85			`P1 : POINTER1 := NEW INTEGER'(0);`
86			`V1 : PACK1.PRIVY := PACK1.ZERO;`
87			`T1 : TASK1;`
88
89			`XI1 : INTEGER RENAMES I1;`
90			`XA1 : ARRAY1 RENAMES A1;`
91			`XR1 : RECORD1 RENAMES R1;`
92			`XP1 : POINTER1 RENAMES P1;`
93			`XV1 : PACK1.PRIVY RENAMES V1;`
94			`XT1 : TASK1 RENAMES T1;`
95			`XK1 : INTEGER RENAMES PACK1.K1;`
96
97			`I : INTEGER;`
98			`CHK_TASK : TASK2;`
99
100			`GENERIC`
101			`GI1 : IN OUT INTEGER;`
102			`GA1 : IN OUT ARRAY1;`
103			`GR1 : IN OUT RECORD1;`
104			`GP1 : IN OUT POINTER1;`
105			`GV1 : IN OUT PACK1.PRIVY;`
106			`GT1 : IN OUT TASK1;`
107			`GK1 : IN OUT INTEGER;`
108			`PACKAGE GENERIC1 IS`
109			`END GENERIC1;`
110
111			`FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS`
112			`BEGIN`
113			`IF EQUAL (3,3) THEN`
114			`RETURN P;`
115			`ELSE`
116			`RETURN NULL;`
117			`END IF;`
118			`END IDENT;`
119
120			`PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;`
121			`PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;`
122			`PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;`
123			`PK1 : OUT INTEGER) IS`
124
125			`BEGIN`
126			`PI1 := PI1 + 1;`
127			`PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);`
128			`PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);`
129			`PP1 := NEW INTEGER'(P1.ALL + 1);`
130			`PV1 := PACK1.NEXT(V1);`
131			`PT1.NEXT;`
132			`PK1 := PACK1.K1 + 1;`
133			`END PROC1;`
134
135			`PACKAGE BODY PACK1 IS`
136			`FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS`
137			`BEGIN`
138			`IF EQUAL(3,3) THEN`
139			`RETURN I;`
140			`ELSE`
141			`RETURN PRIVY'(0);`
142			`END IF;`
143			`END IDENT;`
144
145			`FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS`
146			`BEGIN`
147			`RETURN I+1;`
148			`END NEXT;`
149			`END PACK1;`
150
151			`PACKAGE BODY GENERIC1 IS`
152			`BEGIN`
153			`GI1 := GI1 + 1;`
154			`GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);`
155			`GR1 := (D => 1, FIELD1 => GR1.FIELD1+1);`
156			`GP1 := NEW INTEGER'(GP1.ALL + 1);`
157			`GV1 := PACK1.NEXT(GV1);`
158			`GT1.NEXT;`
159			`GK1 := GK1 + 1;`
160			`END GENERIC1;`
161
162			`TASK BODY TASK1 IS`
163			`TASK_VALUE : INTEGER := 0;`
164			`ACCEPTING_ENTRIES : BOOLEAN := TRUE;`
165			`BEGIN`
166			`WHILE ACCEPTING_ENTRIES LOOP`
167			`SELECT`
168			`ACCEPT ASSIGN (J : IN INTEGER) DO`
169			`TASK_VALUE := J;`
170			`END ASSIGN;`
171			`OR`
172			`ACCEPT VALU (J : OUT INTEGER) DO`
173			`J := TASK_VALUE;`
174			`END VALU;`
175			`OR`
176			`ACCEPT NEXT DO`
177			`TASK_VALUE := TASK_VALUE + 1;`
178			`END NEXT;`
179			`OR`
180			`ACCEPT STOP DO`
181			`ACCEPTING_ENTRIES := FALSE;`
182			`END STOP;`
183			`END SELECT;`
184			`END LOOP;`
185			`END TASK1;`
186
187			`TASK BODY TASK2 IS`
188			`BEGIN`
189			`ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;`
190			`TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;`
191			`TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;`
192			`TK1 : IN OUT INTEGER) DO`
193
194			`TI1 := I1 + 1;`
195			`TA1 := (A1(1)+1, A1(2)+1, A1(3)+1);`
196			`TR1 := (D => 1, FIELD1 => R1.FIELD1 + 1);`
197			`TP1 := NEW INTEGER'(TP1.ALL + 1);`
198			`TV1 := PACK1.NEXT(TV1);`
199			`TT1.NEXT;`
200			`TK1 := TK1 + 1;`
201			`END ENTRY1;`
202			`END TASK2;`
203
204			`BEGIN`
205			`TEST ("C85005A", "CHECK THAT A VARIABLE CREATED BY AN OBJECT " &`
206			`"DECLARATION CAN BE RENAMED AND HAS THE " &`
207			`"CORRECT VALUE, AND THAT THE NEW NAME CAN " &`
208			`"BE USED IN AN ASSIGNMENT STATEMENT " &`
209			`"AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &`
210			`"ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &`
211			`"ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &`
212			`"WHEN THE VALUE OF THE RENAMED VARIABLE IS " &`
213			`"CHANGED, THE NEW VALUE IS REFLECTED BY THE " &`
214			`"VALUE OF THE NEW NAME");`
215
216			`DECLARE`
217			`PACKAGE GENPACK1 IS NEW`
218			`GENERIC1 (XI1, XA1, XR1, XP1, XV1, XT1, XK1);`
219			`BEGIN`
220			`NULL;`
221			`END;`
222
223			`IF XI1 /= IDENT_INT(1) THEN`
224			`FAILED ("INCORRECT VALUE OF XI1 (1)");`
225			`END IF;`
226
227			`IF XA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN`
228			`FAILED ("INCORRECT VALUE OF XA1 (1)");`
229			`END IF;`
230
231			`IF XR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN`
232			`FAILED ("INCORRECT VALUE OF XR1 (1)");`
233			`END IF;`
234
235			`IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(1) THEN`
236			`FAILED ("INCORRECT VALUE OF XP1 (1)");`
237			`END IF;`
238
239			`IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.ONE)) THEN`
240			`FAILED ("INCORRECT VALUE OF XV1 (1)");`
241			`END IF;`
242
243			`XT1.VALU(I);`
244			`IF I /= IDENT_INT(1) THEN`
245			`FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (1)");`
246			`END IF;`
247
248			`IF XK1 /= IDENT_INT(1) THEN`
249			`FAILED ("INCORRECT VALUE OF XK1 (1)");`
250			`END IF;`
251
252			`PROC1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);`
253
254			`IF XI1 /= IDENT_INT(2) THEN`
255			`FAILED ("INCORRECT VALUE OF XI1 (2)");`
256			`END IF;`
257
258			`IF XA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN`
259			`FAILED ("INCORRECT VALUE OF XA1 (2)");`
260			`END IF;`
261
262			`IF XR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN`
263			`FAILED ("INCORRECT VALUE OF XR1 (2)");`
264			`END IF;`
265
266			`IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(2) THEN`
267			`FAILED ("INCORRECT VALUE OF XP1 (2)");`
268			`END IF;`
269
270			`IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.TWO)) THEN`
271			`FAILED ("INCORRECT VALUE OF XV1 (2)");`
272			`END IF;`
273
274			`XT1.VALU(I);`
275			`IF I /= IDENT_INT(2) THEN`
276			`FAILED ("INCORRECT RETURN VALUE FROM XT1.VALU (2)");`
277			`END IF;`
278
279			`IF XK1 /= IDENT_INT(2) THEN`
280			`FAILED ("INCORRECT VALUE OF XK1 (2)");`
281			`END IF;`
282
283			`CHK_TASK.ENTRY1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);`
284
285			`IF XI1 /= IDENT_INT(3) THEN`
286			`FAILED ("INCORRECT VALUE OF XI1 (3)");`
287			`END IF;`
288
289			`IF XA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN`
290			`FAILED ("INCORRECT VALUE OF XA1 (3)");`
291			`END IF;`
292
293			`IF XR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN`
294			`FAILED ("INCORRECT VALUE OF XR1 (3)");`
295			`END IF;`
296
297			`IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(3) THEN`
298			`FAILED ("INCORRECT VALUE OF XP1 (3)");`
299			`END IF;`
300
301			`IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.THREE)) THEN`
302			`FAILED ("INCORRECT VALUE OF XV1 (3)");`
303			`END IF;`
304
305			`XT1.VALU(I);`
306			`IF I /= IDENT_INT(3) THEN`
307			`FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (3)");`
308			`END IF;`
309
310			`IF XK1 /= IDENT_INT(3) THEN`
311			`FAILED ("INCORRECT VALUE OF XK1 (3)");`
312			`END IF;`
313
314			`XI1 := XI1 + 1;`
315			`XA1 := (XA1(1)+1, XA1(2)+1, XA1(3)+1);`
316			`XR1 := (D => 1, FIELD1 => XR1.FIELD1 + 1);`
317			`XP1 := NEW INTEGER'(XP1.ALL + 1);`
318			`XV1 := PACK1.NEXT(XV1);`
319			`XT1.NEXT;`
320			`XK1 := XK1 + 1;`
321
322			`IF XI1 /= IDENT_INT(4) THEN`
323			`FAILED ("INCORRECT VALUE OF XI1 (4)");`
324			`END IF;`
325
326			`IF XA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN`
327			`FAILED ("INCORRECT VALUE OF XA1 (4)");`
328			`END IF;`
329
330			`IF XR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN`
331			`FAILED ("INCORRECT VALUE OF XR1 (4)");`
332			`END IF;`
333
334			`IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(4) THEN`
335			`FAILED ("INCORRECT VALUE OF XP1 (4)");`
336			`END IF;`
337
338			`IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FOUR)) THEN`
339			`FAILED ("INCORRECT VALUE OF XV1 (4)");`
340			`END IF;`
341
342			`XT1.VALU(I);`
343			`IF I /= IDENT_INT(4) THEN`
344			`FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (4)");`
345			`END IF;`
346
347			`IF XK1 /= IDENT_INT(4) THEN`
348			`FAILED ("INCORRECT VALUE OF XK1 (4)");`
349			`END IF;`
350
351			`I1 := I1 + 1;`
352			`A1 := (A1(1)+1, A1(2)+1, A1(3)+1);`
353			`R1 := (D => 1, FIELD1 => R1.FIELD1 + 1);`
354			`P1 := NEW INTEGER'(P1.ALL + 1);`
355			`V1 := PACK1.NEXT(V1);`
356			`T1.NEXT;`
357			`PACK1.K1 := PACK1.K1 + 1;`
358
359			`IF XI1 /= IDENT_INT(5) THEN`
360			`FAILED ("INCORRECT VALUE OF XI1 (5)");`
361			`END IF;`
362
363			`IF XA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN`
364			`FAILED ("INCORRECT VALUE OF XA1 (5)");`
365			`END IF;`
366
367			`IF XR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN`
368			`FAILED ("INCORRECT VALUE OF XR1 (5)");`
369			`END IF;`
370
371			`IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(5) THEN`
372			`FAILED ("INCORRECT VALUE OF XP1 (5)");`
373			`END IF;`
374
375			`IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FIVE)) THEN`
376			`FAILED ("INCORRECT VALUE OF XV1 (5)");`
377			`END IF;`
378
379			`XT1.VALU(I);`
380			`IF I /= IDENT_INT(5) THEN`
381			`FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (5)");`
382			`END IF;`
383
384			`IF XK1 /= IDENT_INT(5) THEN`
385			`FAILED ("INCORRECT VALUE OF XK1 (5)");`
386			`END IF;`
387
388			`T1.STOP;`
389
390			`RESULT;`
391			`END C85005A;`