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/] [c85005b.ada] - Blame information for rev 316

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


-- C85005B.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 SUBPROGRAM '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 C85005B 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
     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;
     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;
 
     PROCEDURE PROC (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
                     PR1 : IN OUT RECORD1; PP1 : IN OUT POINTER1;
                     PV1 : IN OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS
          XPI1 : INTEGER RENAMES PI1;
          XPA1 : ARRAY1 RENAMES PA1;
          XPR1 : RECORD1 RENAMES PR1;
          XPP1 : POINTER1 RENAMES PP1;
          XPV1 : PACK1.PRIVY RENAMES PV1;
          XPT1 : TASK1 RENAMES PT1;
 
          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;
 
          CHK_TASK : TASK2;
 
          PROCEDURE PROC1 (PPI1 : IN OUT INTEGER; PPA1 : IN OUT ARRAY1;
                           PPR1 : IN OUT RECORD1; PPP1 : OUT POINTER1;
                           PPV1 : OUT PACK1.PRIVY;
                           PPT1 : IN OUT TASK1) IS
          BEGIN
               PPI1 := PPI1 + 1;
               PPA1 := (PPA1(1)+1, PPA1(2)+1, PPA1(3)+1);
               PPR1 := (D => 1, FIELD1 => PPR1.FIELD1 + 1);
               PPP1 := NEW INTEGER'(PP1.ALL + 1);
               PPV1 := PACK1.NEXT(PV1);
               PPT1.NEXT;
          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)
               DO
                    TI1 := PI1 + 1;
                    TA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
                    TR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
                    TP1 := NEW INTEGER'(TP1.ALL + 1);
                    TV1 := PACK1.NEXT(TV1);
                    TT1.NEXT;
               END ENTRY1;
          END TASK2;
 
          PACKAGE GENPACK1 IS NEW GENERIC1
               (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
 
     BEGIN
          IF XPI1 /= IDENT_INT(1) THEN
               FAILED ("INCORRECT VALUE OF XPI1 (1)");
          END IF;
 
          IF XPA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
               FAILED ("INCORRECT VALUE OF XPA1 (1)");
          END IF;
 
          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
               FAILED ("INCORRECT VALUE OF XPR1 (1)");
          END IF;
 
          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(1) THEN
               FAILED ("INCORRECT VALUE OF XPP1 (1)");
          END IF;
 
          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.ONE)) THEN
               FAILED ("INCORRECT VALUE OF XPV1 (1)");
          END IF;
 
          XPT1.VALU(I);
          IF I /= IDENT_INT(1) THEN
               FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (1)");
          END IF;
 
          PROC1(XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
 
          IF XPI1 /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE OF XPI1 (2)");
          END IF;
 
          IF XPA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
               FAILED ("INCORRECT VALUE OF XPA1 (2)");
          END IF;
 
          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
               FAILED ("INCORRECT VALUE OF XPR1 (2)");
          END IF;
 
          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE OF XPP1 (2)");
          END IF;
 
          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.TWO)) THEN
               FAILED ("INCORRECT VALUE OF XPV1 (2)");
          END IF;
 
          XPT1.VALU(I);
          IF I /= IDENT_INT(2) THEN
               FAILED ("INCORRECT RETURN VALUE FROM XPT1.VALU (2)");
          END IF;
 
          CHK_TASK.ENTRY1 (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
 
          IF XPI1 /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE OF XPI1 (3)");
          END IF;
 
          IF XPA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
               FAILED ("INCORRECT VALUE OF XPA1 (3)");
          END IF;
 
          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
               FAILED ("INCORRECT VALUE OF XPR1 (3)");
          END IF;
 
          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE OF XPP1 (3)");
          END IF;
 
          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.THREE)) THEN
               FAILED ("INCORRECT VALUE OF XPV1 (3)");
          END IF;
 
          XPT1.VALU(I);
          IF I /= IDENT_INT(3) THEN
               FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (3)");
          END IF;
 
          XPI1 := XPI1 + 1;
          XPA1 := (XPA1(1)+1, XPA1(2)+1, XPA1(3)+1);
          XPR1 := (D => 1, FIELD1 => XPR1.FIELD1 + 1);
          XPP1 := NEW INTEGER'(XPP1.ALL + 1);
          XPV1 := PACK1.NEXT(XPV1);
          XPT1.NEXT;
 
          IF XPI1 /= IDENT_INT(4) THEN
               FAILED ("INCORRECT VALUE OF XPI1 (4)");
          END IF;
 
          IF XPA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
               FAILED ("INCORRECT VALUE OF XPA1 (4)");
          END IF;
 
          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
               FAILED ("INCORRECT VALUE OF XPR1 (4)");
          END IF;
 
          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(4) THEN
               FAILED ("INCORRECT VALUE OF XPP1 (4)");
          END IF;
 
          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FOUR)) THEN
               FAILED ("INCORRECT VALUE OF XPV1 (4)");
          END IF;
 
          XPT1.VALU(I);
          IF I /= IDENT_INT(4) THEN
               FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (4)");
          END IF;
 
          PI1 := PI1 + 1;
          PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
          PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
          PP1 := NEW INTEGER'(PP1.ALL + 1);
          PV1 := PACK1.NEXT(PV1);
          PT1.NEXT;
 
          IF XPI1 /= IDENT_INT(5) THEN
               FAILED ("INCORRECT VALUE OF XPI1 (5)");
          END IF;
 
          IF XPA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
               FAILED ("INCORRECT VALUE OF XPA1 (5)");
          END IF;
 
          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
               FAILED ("INCORRECT VALUE OF XPR1 (5)");
          END IF;
 
          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(5) THEN
               FAILED ("INCORRECT VALUE OF XPP1 (5)");
          END IF;
 
          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FIVE)) THEN
               FAILED ("INCORRECT VALUE OF XPV1 (5)");
          END IF;
 
          XPT1.VALU(I);
          IF I /= IDENT_INT(5) THEN
               FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (5)");
          END IF;
     END PROC;
 
BEGIN
     TEST ("C85005B", "CHECK THAT A VARIABLE CREATED BY A SUBPROGRAM " &
                      "'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");
 
     PROC (DI1, DA1, DR1, DP1, DV1, DT1);
 
     DT1.STOP;
 
     RESULT;
END C85005B;

Browse

Tools

Subversion Repositories openrisc_me

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

Line No.	Rev	Author	Line
1	294	jeremybenn	`-- C85005B.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 SUBPROGRAM 'IN OUT' FORMAL`
27			`-- PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT`
28			`-- THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED`
29			`-- ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,`
30			`-- AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE`
31			`-- VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS`
32			`-- 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 C85005B 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			`BEGIN`
120			`GI1 := GI1 + 1;`
121			`GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);`
122			`GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);`
123			`GP1 := NEW INTEGER'(GP1.ALL + 1);`
124			`GV1 := PACK1.NEXT(GV1);`
125			`GT1.NEXT;`
126			`END GENERIC1;`
127
128			`TASK BODY TASK1 IS`
129			`TASK_VALUE : INTEGER := 0;`
130			`ACCEPTING_ENTRIES : BOOLEAN := TRUE;`
131			`BEGIN`
132			`WHILE ACCEPTING_ENTRIES LOOP`
133			`SELECT`
134			`ACCEPT ASSIGN (J : IN INTEGER) DO`
135			`TASK_VALUE := J;`
136			`END ASSIGN;`
137			`OR`
138			`ACCEPT VALU (J : OUT INTEGER) DO`
139			`J := TASK_VALUE;`
140			`END VALU;`
141			`OR`
142			`ACCEPT NEXT DO`
143			`TASK_VALUE := TASK_VALUE + 1;`
144			`END NEXT;`
145			`OR`
146			`ACCEPT STOP DO`
147			`ACCEPTING_ENTRIES := FALSE;`
148			`END STOP;`
149			`END SELECT;`
150			`END LOOP;`
151			`END TASK1;`
152
153			`PROCEDURE PROC (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;`
154			`PR1 : IN OUT RECORD1; PP1 : IN OUT POINTER1;`
155			`PV1 : IN OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS`
156			`XPI1 : INTEGER RENAMES PI1;`
157			`XPA1 : ARRAY1 RENAMES PA1;`
158			`XPR1 : RECORD1 RENAMES PR1;`
159			`XPP1 : POINTER1 RENAMES PP1;`
160			`XPV1 : PACK1.PRIVY RENAMES PV1;`
161			`XPT1 : TASK1 RENAMES PT1;`
162
163			`TASK TYPE TASK2 IS`
164			`ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;`
165			`TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;`
166			`TV1 : IN OUT PACK1.PRIVY;`
167			`TT1 : IN OUT TASK1);`
168			`END TASK2;`
169
170			`CHK_TASK : TASK2;`
171
172			`PROCEDURE PROC1 (PPI1 : IN OUT INTEGER; PPA1 : IN OUT ARRAY1;`
173			`PPR1 : IN OUT RECORD1; PPP1 : OUT POINTER1;`
174			`PPV1 : OUT PACK1.PRIVY;`
175			`PPT1 : IN OUT TASK1) IS`
176			`BEGIN`
177			`PPI1 := PPI1 + 1;`
178			`PPA1 := (PPA1(1)+1, PPA1(2)+1, PPA1(3)+1);`
179			`PPR1 := (D => 1, FIELD1 => PPR1.FIELD1 + 1);`
180			`PPP1 := NEW INTEGER'(PP1.ALL + 1);`
181			`PPV1 := PACK1.NEXT(PV1);`
182			`PPT1.NEXT;`
183			`END PROC1;`
184
185			`TASK BODY TASK2 IS`
186			`BEGIN`
187			`ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;`
188			`TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;`
189			`TV1 : IN OUT PACK1.PRIVY;`
190			`TT1 : IN OUT TASK1)`
191			`DO`
192			`TI1 := PI1 + 1;`
193			`TA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);`
194			`TR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);`
195			`TP1 := NEW INTEGER'(TP1.ALL + 1);`
196			`TV1 := PACK1.NEXT(TV1);`
197			`TT1.NEXT;`
198			`END ENTRY1;`
199			`END TASK2;`
200
201			`PACKAGE GENPACK1 IS NEW GENERIC1`
202			`(XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);`
203
204			`BEGIN`
205			`IF XPI1 /= IDENT_INT(1) THEN`
206			`FAILED ("INCORRECT VALUE OF XPI1 (1)");`
207			`END IF;`
208
209			`IF XPA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN`
210			`FAILED ("INCORRECT VALUE OF XPA1 (1)");`
211			`END IF;`
212
213			`IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN`
214			`FAILED ("INCORRECT VALUE OF XPR1 (1)");`
215			`END IF;`
216
217			`IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(1) THEN`
218			`FAILED ("INCORRECT VALUE OF XPP1 (1)");`
219			`END IF;`
220
221			`IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.ONE)) THEN`
222			`FAILED ("INCORRECT VALUE OF XPV1 (1)");`
223			`END IF;`
224
225			`XPT1.VALU(I);`
226			`IF I /= IDENT_INT(1) THEN`
227			`FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (1)");`
228			`END IF;`
229
230			`PROC1(XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);`
231
232			`IF XPI1 /= IDENT_INT(2) THEN`
233			`FAILED ("INCORRECT VALUE OF XPI1 (2)");`
234			`END IF;`
235
236			`IF XPA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN`
237			`FAILED ("INCORRECT VALUE OF XPA1 (2)");`
238			`END IF;`
239
240			`IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN`
241			`FAILED ("INCORRECT VALUE OF XPR1 (2)");`
242			`END IF;`
243
244			`IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(2) THEN`
245			`FAILED ("INCORRECT VALUE OF XPP1 (2)");`
246			`END IF;`
247
248			`IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.TWO)) THEN`
249			`FAILED ("INCORRECT VALUE OF XPV1 (2)");`
250			`END IF;`
251
252			`XPT1.VALU(I);`
253			`IF I /= IDENT_INT(2) THEN`
254			`FAILED ("INCORRECT RETURN VALUE FROM XPT1.VALU (2)");`
255			`END IF;`
256
257			`CHK_TASK.ENTRY1 (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);`
258
259			`IF XPI1 /= IDENT_INT(3) THEN`
260			`FAILED ("INCORRECT VALUE OF XPI1 (3)");`
261			`END IF;`
262
263			`IF XPA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN`
264			`FAILED ("INCORRECT VALUE OF XPA1 (3)");`
265			`END IF;`
266
267			`IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN`
268			`FAILED ("INCORRECT VALUE OF XPR1 (3)");`
269			`END IF;`
270
271			`IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(3) THEN`
272			`FAILED ("INCORRECT VALUE OF XPP1 (3)");`
273			`END IF;`
274
275			`IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.THREE)) THEN`
276			`FAILED ("INCORRECT VALUE OF XPV1 (3)");`
277			`END IF;`
278
279			`XPT1.VALU(I);`
280			`IF I /= IDENT_INT(3) THEN`
281			`FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (3)");`
282			`END IF;`
283
284			`XPI1 := XPI1 + 1;`
285			`XPA1 := (XPA1(1)+1, XPA1(2)+1, XPA1(3)+1);`
286			`XPR1 := (D => 1, FIELD1 => XPR1.FIELD1 + 1);`
287			`XPP1 := NEW INTEGER'(XPP1.ALL + 1);`
288			`XPV1 := PACK1.NEXT(XPV1);`
289			`XPT1.NEXT;`
290
291			`IF XPI1 /= IDENT_INT(4) THEN`
292			`FAILED ("INCORRECT VALUE OF XPI1 (4)");`
293			`END IF;`
294
295			`IF XPA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN`
296			`FAILED ("INCORRECT VALUE OF XPA1 (4)");`
297			`END IF;`
298
299			`IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN`
300			`FAILED ("INCORRECT VALUE OF XPR1 (4)");`
301			`END IF;`
302
303			`IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(4) THEN`
304			`FAILED ("INCORRECT VALUE OF XPP1 (4)");`
305			`END IF;`
306
307			`IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FOUR)) THEN`
308			`FAILED ("INCORRECT VALUE OF XPV1 (4)");`
309			`END IF;`
310
311			`XPT1.VALU(I);`
312			`IF I /= IDENT_INT(4) THEN`
313			`FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (4)");`
314			`END IF;`
315
316			`PI1 := PI1 + 1;`
317			`PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);`
318			`PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);`
319			`PP1 := NEW INTEGER'(PP1.ALL + 1);`
320			`PV1 := PACK1.NEXT(PV1);`
321			`PT1.NEXT;`
322
323			`IF XPI1 /= IDENT_INT(5) THEN`
324			`FAILED ("INCORRECT VALUE OF XPI1 (5)");`
325			`END IF;`
326
327			`IF XPA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN`
328			`FAILED ("INCORRECT VALUE OF XPA1 (5)");`
329			`END IF;`
330
331			`IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN`
332			`FAILED ("INCORRECT VALUE OF XPR1 (5)");`
333			`END IF;`
334
335			`IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(5) THEN`
336			`FAILED ("INCORRECT VALUE OF XPP1 (5)");`
337			`END IF;`
338
339			`IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FIVE)) THEN`
340			`FAILED ("INCORRECT VALUE OF XPV1 (5)");`
341			`END IF;`
342
343			`XPT1.VALU(I);`
344			`IF I /= IDENT_INT(5) THEN`
345			`FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (5)");`
346			`END IF;`
347			`END PROC;`
348
349			`BEGIN`
350			`TEST ("C85005B", "CHECK THAT A VARIABLE CREATED BY A SUBPROGRAM " &`
351			`"'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &`
352			`"AND HAS THE CORRECT VALUE, AND THAT THE NEW " &`
353			`"NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &`
354			`"AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &`
355			`"ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &`
356			`"ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &`
357			`"WHEN THE VALUE OF THE RENAMED VARIABLE IS " &`
358			`"CHANGED, THE NEW VALUE IS REFLECTED BY THE " &`
359			`"VALUE OF THE NEW NAME");`
360
361			`PROC (DI1, DA1, DR1, DP1, DV1, DT1);`
362
363			`DT1.STOP;`
364
365			`RESULT;`
366			`END C85005B;`