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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log


-- C85005D.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 A GENERIC 'IN OUT' FORMAL
--     PARAMETER 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 C85005D 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;
 
     DI1 : INTEGER := 0;
     DA1 : ARRAY1(1..3) := (OTHERS => 0);
     DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
     DP1 : POINTER1 := NEW INTEGER'(0);
     DV1 : PACK1.PRIVY := PACK1.ZERO;
     DT1 : TASK1;
 
     I : INTEGER;
 
     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;
     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
          XGI1 : INTEGER RENAMES GI1;
          XGA1 : ARRAY1 RENAMES GA1;
          XGR1 : RECORD1 RENAMES GR1;
          XGP1 : POINTER1 RENAMES GP1;
          XGV1 : PACK1.PRIVY RENAMES GV1;
          XGT1 : TASK1 RENAMES GT1;
 
          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);
          END TASK2;
 
          G_CHK_TASK : TASK2;
 
          GENERIC
               GGI1 : IN OUT INTEGER;
               GGA1 : IN OUT ARRAY1;
               GGR1 : IN OUT RECORD1;
               GGP1 : IN OUT POINTER1;
               GGV1 : IN OUT PACK1.PRIVY;
               GGT1 : IN OUT TASK1;
          PACKAGE GENERIC2 IS
          END GENERIC2;
 
          PACKAGE BODY GENERIC2 IS
          BEGIN
               GGI1 := GGI1 + 1;
               GGA1 := (GGA1(1)+1, GGA1(2)+1, GGA1(3)+1);
               GGR1 := (D => 1, FIELD1 => GGR1.FIELD1 + 1);
               GGP1 := NEW INTEGER'(GGP1.ALL + 1);
               GGV1 := PACK1.NEXT(GGV1);
               GGT1.NEXT;
          END GENERIC2;
 
          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)
               DO
                    TI1 := GI1 + 1;
                    TA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
                    TR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
                    TP1 := NEW INTEGER'(TP1.ALL + 1);
                    TV1 := PACK1.NEXT(TV1);
                    TT1.NEXT;
               END ENTRY1;
          END 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) 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'(GP1.ALL + 1);
               PV1 := PACK1.NEXT(GV1);
               PT1.NEXT;
          END PROC1;
 
          PACKAGE GENPACK2 IS NEW GENERIC2
               (XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
 
     BEGIN
          IF XGI1 /= IDENT_INT(1) THEN
               FAILED ("INCORRECT VALUE OF XGI1 (1)");
          END IF;
 
          IF XGA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
               FAILED ("INCORRECT VALUE OF XGA1 (1)");
          END IF;
 
          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
               FAILED ("INCORRECT VALUE OF XGR1 (1)");
          END IF;
 
          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(1) THEN
               FAILED ("INCORRECT VALUE OF XGP1 (1)");
          END IF;
 
          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.ONE)) THEN
               FAILED ("INCORRECT VALUE OF XGV1 (1)");
          END IF;
 
          XGT1.VALU(I);
          IF I /= IDENT_INT(1) THEN
               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (1)");
          END IF;
 
          PROC1(XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
 
          IF XGI1 /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE OF XGI1 (2)");
          END IF;
 
          IF XGA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
               FAILED ("INCORRECT VALUE OF XGA1 (2)");
          END IF;
 
          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
               FAILED ("INCORRECT VALUE OF XGR1 (2)");
          END IF;
 
          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE OF XGP1 (2)");
          END IF;
 
          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.TWO)) THEN
               FAILED ("INCORRECT VALUE OF XGV1 (2)");
          END IF;
 
          XGT1.VALU(I);
          IF I /= IDENT_INT(2) THEN
               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (2)");
          END IF;
 
          G_CHK_TASK.ENTRY1(XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
 
          IF XGI1 /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE OF XGI1 (3)");
          END IF;
 
          IF XGA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
               FAILED ("INCORRECT VALUE OF XGA1 (3)");
          END IF;
 
          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
               FAILED ("INCORRECT VALUE OF XGR1 (3)");
          END IF;
 
          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE OF XGP1 (3)");
          END IF;
 
          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.THREE)) THEN
               FAILED ("INCORRECT VALUE OF XGV1 (3)");
          END IF;
 
          XGT1.VALU(I);
          IF I /= IDENT_INT(3) THEN
               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (3)");
          END IF;
 
          XGI1 := XGI1 + 1;
          XGA1 := (XGA1(1)+1, XGA1(2)+1, XGA1(3)+1);
          XGR1 := (D => 1, FIELD1 => XGR1.FIELD1 + 1);
          XGP1 := NEW INTEGER'(XGP1.ALL + 1);
          XGV1 := PACK1.NEXT(XGV1);
          XGT1.NEXT;
 
          IF XGI1 /= IDENT_INT(4) THEN
               FAILED ("INCORRECT VALUE OF XGI1 (4)");
          END IF;
 
          IF XGA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
               FAILED ("INCORRECT VALUE OF XGA1 (4)");
          END IF;
 
          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
               FAILED ("INCORRECT VALUE OF XGR1 (4)");
          END IF;
 
          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(4) THEN
               FAILED ("INCORRECT VALUE OF XGP1 (4)");
          END IF;
 
          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.FOUR)) THEN
               FAILED ("INCORRECT VALUE OF XGV1 (4)");
          END IF;
 
          XGT1.VALU(I);
          IF I /= IDENT_INT(4) THEN
               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (4)");
          END IF;
 
          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;
 
          IF XGI1 /= IDENT_INT(5) THEN
               FAILED ("INCORRECT VALUE OF XGI1 (5)");
          END IF;
 
          IF XGA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
               FAILED ("INCORRECT VALUE OF XGA1 (5)");
          END IF;
 
          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
               FAILED ("INCORRECT VALUE OF XGR1 (5)");
          END IF;
 
          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(5) THEN
               FAILED ("INCORRECT VALUE OF XGP1 (5)");
          END IF;
 
          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.FIVE)) THEN
               FAILED ("INCORRECT VALUE OF XGV1 (5)");
          END IF;
 
          XGT1.VALU(I);
          IF I /= IDENT_INT(5) THEN
               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (5)");
          END IF;
     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 ("C85005D", "CHECK THAT A VARIABLE CREATED BY A GENERIC " &
                      "'IN OUT' FORMAL PARAMETER 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 (DI1, DA1, DR1, DP1, DV1, DT1);
     BEGIN
          NULL;
     END;
 
     DT1.STOP;
 
     RESULT;
END C85005D;

Browse

Tools

Subversion Repositories openrisc

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

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