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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c85005e.ada] - Blame information for rev 816

Details | Compare with Previous | View Log


-- C85005E.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 ALLOCATOR 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 C85005E 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 PACKACC IS ACCESS INTEGER;
          AK1 : PACKACC := NEW 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;
 
     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;
 
     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;
 
BEGIN
     TEST ("C85005E", "CHECK THAT A VARIABLE CREATED BY AN ALLOCATOR " &
                      "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
          TYPE ACCINT IS ACCESS INTEGER;
          TYPE ACCARR IS ACCESS ARRAY1;
          TYPE ACCREC IS ACCESS RECORD1;
          TYPE ACCPTR IS ACCESS POINTER1;
          TYPE ACCPVT IS ACCESS PACK1.PRIVY;
          TYPE ACCTSK IS ACCESS TASK1;
 
          AI1 : ACCINT := NEW INTEGER'(0);
          AA1 : ACCARR := NEW ARRAY1'(0, 0, 0);
          AR1 : ACCREC := NEW RECORD1'(D => 1, FIELD1 => 0);
          AP1 : ACCPTR := NEW POINTER1'(NEW INTEGER'(0));
          AV1 : ACCPVT := NEW PACK1.PRIVY'(PACK1.ZERO);
          AT1 : ACCTSK := NEW TASK1;
 
          XAI1 : INTEGER RENAMES AI1.ALL;
          XAA1 : ARRAY1 RENAMES AA1.ALL;
          XAR1 : RECORD1 RENAMES AR1.ALL;
          XAP1 : POINTER1 RENAMES AP1.ALL;
          XAV1 : PACK1.PRIVY RENAMES AV1.ALL;
          XAK1 : INTEGER RENAMES PACK1.AK1.ALL;
          XAT1 : TASK1 RENAMES AT1.ALL;
 
          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;
 
          I : INTEGER;
          A_CHK_TASK : TASK2;
 
          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'(AP1.ALL.ALL + 1);
               PV1 := PACK1.NEXT(AV1.ALL);
               PT1.NEXT;
               PK1 := PACK1.AK1.ALL + 1;
          END PROC1;
 
          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 := AI1.ALL + 1;
                    TA1 := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
                    TR1 := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
                    TP1 := NEW INTEGER'(TP1.ALL + 1);
                    TV1 := PACK1.NEXT(TV1);
                    TT1.NEXT;
                    TK1 := TK1 + 1;
               END ENTRY1;
          END TASK2;
 
          PACKAGE GENPACK2 IS NEW
               GENERIC1 (XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
 
     BEGIN
          IF XAI1 /= IDENT_INT(1) THEN
               FAILED ("INCORRECT VALUE OF XAI1 (1)");
          END IF;
 
          IF XAA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
               FAILED ("INCORRECT VALUE OF XAA1 (1)");
          END IF;
 
          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
               FAILED ("INCORRECT VALUE OF XAR1 (1)");
          END IF;
 
          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(1) THEN
               FAILED ("INCORRECT VALUE OF XAP1 (1)");
          END IF;
 
          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.ONE)) THEN
               FAILED ("INCORRECT VALUE OF XAV1 (1)");
          END IF;
 
          XAT1.VALU(I);
          IF I /= IDENT_INT(1) THEN
               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (1)");
          END IF;
 
          IF XAK1 /= IDENT_INT(1) THEN
               FAILED ("INCORRECT VALUE OF XAK1 (1)");
          END IF;
 
          PROC1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
 
          IF XAI1 /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE OF XAI1 (2)");
          END IF;
 
          IF XAA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
               FAILED ("INCORRECT VALUE OF XAA1 (2)");
          END IF;
 
          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
               FAILED ("INCORRECT VALUE OF XAR1 (2)");
          END IF;
 
          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE OF XAP1 (2)");
          END IF;
 
          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.TWO)) THEN
               FAILED ("INCORRECT VALUE OF XAV1 (2)");
          END IF;
 
          XAT1.VALU(I);
          IF I /= IDENT_INT(2) THEN
               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (2)");
          END IF;
 
          IF XAK1 /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE OF XAK1 (2)");
          END IF;
 
          A_CHK_TASK.ENTRY1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
 
          IF XAI1 /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE OF XAI1 (3)");
          END IF;
 
          IF XAA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
               FAILED ("INCORRECT VALUE OF XAA1 (3)");
          END IF;
 
          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
               FAILED ("INCORRECT VALUE OF XAR1 (3)");
          END IF;
 
          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE OF XAP1 (3)");
          END IF;
 
          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.THREE)) THEN
               FAILED ("INCORRECT VALUE OF XAV1 (3)");
          END IF;
 
          XAT1.VALU(I);
          IF I /= IDENT_INT(3) THEN
               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (3)");
          END IF;
 
          IF XAK1 /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE OF XAK1 (3)");
          END IF;
 
          XAI1 := XAI1 + 1;
          XAA1 := (XAA1(1)+1, XAA1(2)+1, XAA1(3)+1);
          XAR1 := (D => 1, FIELD1 => XAR1.FIELD1 + 1);
          XAP1 := NEW INTEGER'(XAP1.ALL + 1);
          XAV1 := PACK1.NEXT(XAV1);
          XAT1.NEXT;
          XAK1 := XAK1 + 1;
 
          IF XAI1 /= IDENT_INT(4) THEN
               FAILED ("INCORRECT VALUE OF XAI1 (4)");
          END IF;
 
          IF XAA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
               FAILED ("INCORRECT VALUE OF XAA1 (4)");
          END IF;
 
          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
               FAILED ("INCORRECT VALUE OF XAR1 (4)");
          END IF;
 
          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(4) THEN
               FAILED ("INCORRECT VALUE OF XAP1 (4)");
          END IF;
 
          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FOUR)) THEN
               FAILED ("INCORRECT VALUE OF XAV1 (4)");
          END IF;
 
          XAT1.VALU(I);
          IF I /= IDENT_INT(4) THEN
               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (4)");
          END IF;
 
          IF XAK1 /= IDENT_INT(4) THEN
               FAILED ("INCORRECT VALUE OF XAK1 (4)");
          END IF;
 
          AI1.ALL := AI1.ALL + 1;
          AA1.ALL := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
          AR1.ALL := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
          AP1.ALL := NEW INTEGER'(AP1.ALL.ALL + 1);
          AV1.ALL := PACK1.NEXT(AV1.ALL);
          AT1.NEXT;
          PACK1.AK1.ALL := PACK1.AK1.ALL + 1;
 
          IF XAI1 /= IDENT_INT(5) THEN
               FAILED ("INCORRECT VALUE OF XAI1 (5)");
          END IF;
 
          IF XAA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
               FAILED ("INCORRECT VALUE OF XAA1 (5)");
          END IF;
 
          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
               FAILED ("INCORRECT VALUE OF XAR1 (5)");
          END IF;
 
          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(5) THEN
               FAILED ("INCORRECT VALUE OF XAP1 (5)");
          END IF;
 
          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FIVE)) THEN
               FAILED ("INCORRECT VALUE OF XAV1 (5)");
          END IF;
 
          XAT1.VALU(I);
          IF I /= IDENT_INT(5) THEN
               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (5)");
          END IF;
 
          IF XAK1 /= IDENT_INT(5) THEN
               FAILED ("INCORRECT VALUE OF XAK1 (5)");
          END IF;
 
          AT1.STOP;
     END;
 
     RESULT;
END C85005E;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c85005e.ada] - Blame information for rev 816

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