annotate gcc/testsuite/ada/acats/tests/c8/c85005e.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- C85005E.ADA
kono
parents:
diff changeset
2
kono
parents:
diff changeset
3 -- Grant of Unlimited Rights
kono
parents:
diff changeset
4 --
kono
parents:
diff changeset
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
kono
parents:
diff changeset
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
kono
parents:
diff changeset
7 -- unlimited rights in the software and documentation contained herein.
kono
parents:
diff changeset
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
kono
parents:
diff changeset
9 -- this public release, the Government intends to confer upon all
kono
parents:
diff changeset
10 -- recipients unlimited rights equal to those held by the Government.
kono
parents:
diff changeset
11 -- These rights include rights to use, duplicate, release or disclose the
kono
parents:
diff changeset
12 -- released technical data and computer software in whole or in part, in
kono
parents:
diff changeset
13 -- any manner and for any purpose whatsoever, and to have or permit others
kono
parents:
diff changeset
14 -- to do so.
kono
parents:
diff changeset
15 --
kono
parents:
diff changeset
16 -- DISCLAIMER
kono
parents:
diff changeset
17 --
kono
parents:
diff changeset
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
kono
parents:
diff changeset
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
kono
parents:
diff changeset
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
kono
parents:
diff changeset
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
kono
parents:
diff changeset
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
kono
parents:
diff changeset
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
kono
parents:
diff changeset
24 --*
kono
parents:
diff changeset
25 -- OBJECTIVE:
kono
parents:
diff changeset
26 -- CHECK THAT A VARIABLE CREATED BY AN ALLOCATOR CAN BE RENAMED AND
kono
parents:
diff changeset
27 -- HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN
kono
parents:
diff changeset
28 -- ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR
kono
parents:
diff changeset
29 -- ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC
kono
parents:
diff changeset
30 -- 'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED
kono
parents:
diff changeset
31 -- VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF
kono
parents:
diff changeset
32 -- THE NEW NAME.
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 -- HISTORY:
kono
parents:
diff changeset
35 -- JET 03/15/88 CREATED ORIGINAL TEST.
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 WITH REPORT; USE REPORT;
kono
parents:
diff changeset
38 PROCEDURE C85005E IS
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
kono
parents:
diff changeset
41 TYPE RECORD1 (D : INTEGER) IS
kono
parents:
diff changeset
42 RECORD
kono
parents:
diff changeset
43 FIELD1 : INTEGER := 1;
kono
parents:
diff changeset
44 END RECORD;
kono
parents:
diff changeset
45 TYPE POINTER1 IS ACCESS INTEGER;
kono
parents:
diff changeset
46
kono
parents:
diff changeset
47 PACKAGE PACK1 IS
kono
parents:
diff changeset
48 TYPE PACKACC IS ACCESS INTEGER;
kono
parents:
diff changeset
49 AK1 : PACKACC := NEW INTEGER'(0);
kono
parents:
diff changeset
50 TYPE PRIVY IS PRIVATE;
kono
parents:
diff changeset
51 ZERO : CONSTANT PRIVY;
kono
parents:
diff changeset
52 ONE : CONSTANT PRIVY;
kono
parents:
diff changeset
53 TWO : CONSTANT PRIVY;
kono
parents:
diff changeset
54 THREE : CONSTANT PRIVY;
kono
parents:
diff changeset
55 FOUR : CONSTANT PRIVY;
kono
parents:
diff changeset
56 FIVE : CONSTANT PRIVY;
kono
parents:
diff changeset
57 FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
kono
parents:
diff changeset
58 FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
kono
parents:
diff changeset
59 PRIVATE
kono
parents:
diff changeset
60 TYPE PRIVY IS RANGE 0..127;
kono
parents:
diff changeset
61 ZERO : CONSTANT PRIVY := 0;
kono
parents:
diff changeset
62 ONE : CONSTANT PRIVY := 1;
kono
parents:
diff changeset
63 TWO : CONSTANT PRIVY := 2;
kono
parents:
diff changeset
64 THREE : CONSTANT PRIVY := 3;
kono
parents:
diff changeset
65 FOUR : CONSTANT PRIVY := 4;
kono
parents:
diff changeset
66 FIVE : CONSTANT PRIVY := 5;
kono
parents:
diff changeset
67 END PACK1;
kono
parents:
diff changeset
68
kono
parents:
diff changeset
69 TASK TYPE TASK1 IS
kono
parents:
diff changeset
70 ENTRY ASSIGN (J : IN INTEGER);
kono
parents:
diff changeset
71 ENTRY VALU (J : OUT INTEGER);
kono
parents:
diff changeset
72 ENTRY NEXT;
kono
parents:
diff changeset
73 ENTRY STOP;
kono
parents:
diff changeset
74 END TASK1;
kono
parents:
diff changeset
75
kono
parents:
diff changeset
76 GENERIC
kono
parents:
diff changeset
77 GI1 : IN OUT INTEGER;
kono
parents:
diff changeset
78 GA1 : IN OUT ARRAY1;
kono
parents:
diff changeset
79 GR1 : IN OUT RECORD1;
kono
parents:
diff changeset
80 GP1 : IN OUT POINTER1;
kono
parents:
diff changeset
81 GV1 : IN OUT PACK1.PRIVY;
kono
parents:
diff changeset
82 GT1 : IN OUT TASK1;
kono
parents:
diff changeset
83 GK1 : IN OUT INTEGER;
kono
parents:
diff changeset
84 PACKAGE GENERIC1 IS
kono
parents:
diff changeset
85 END GENERIC1;
kono
parents:
diff changeset
86
kono
parents:
diff changeset
87 FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
kono
parents:
diff changeset
88 BEGIN
kono
parents:
diff changeset
89 IF EQUAL (3,3) THEN
kono
parents:
diff changeset
90 RETURN P;
kono
parents:
diff changeset
91 ELSE
kono
parents:
diff changeset
92 RETURN NULL;
kono
parents:
diff changeset
93 END IF;
kono
parents:
diff changeset
94 END IDENT;
kono
parents:
diff changeset
95
kono
parents:
diff changeset
96 PACKAGE BODY PACK1 IS
kono
parents:
diff changeset
97 FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
kono
parents:
diff changeset
98 BEGIN
kono
parents:
diff changeset
99 IF EQUAL(3,3) THEN
kono
parents:
diff changeset
100 RETURN I;
kono
parents:
diff changeset
101 ELSE
kono
parents:
diff changeset
102 RETURN PRIVY'(0);
kono
parents:
diff changeset
103 END IF;
kono
parents:
diff changeset
104 END IDENT;
kono
parents:
diff changeset
105
kono
parents:
diff changeset
106 FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
kono
parents:
diff changeset
107 BEGIN
kono
parents:
diff changeset
108 RETURN I+1;
kono
parents:
diff changeset
109 END NEXT;
kono
parents:
diff changeset
110 END PACK1;
kono
parents:
diff changeset
111
kono
parents:
diff changeset
112 PACKAGE BODY GENERIC1 IS
kono
parents:
diff changeset
113 BEGIN
kono
parents:
diff changeset
114 GI1 := GI1 + 1;
kono
parents:
diff changeset
115 GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
kono
parents:
diff changeset
116 GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
kono
parents:
diff changeset
117 GP1 := NEW INTEGER'(GP1.ALL + 1);
kono
parents:
diff changeset
118 GV1 := PACK1.NEXT(GV1);
kono
parents:
diff changeset
119 GT1.NEXT;
kono
parents:
diff changeset
120 GK1 := GK1 + 1;
kono
parents:
diff changeset
121 END GENERIC1;
kono
parents:
diff changeset
122
kono
parents:
diff changeset
123 TASK BODY TASK1 IS
kono
parents:
diff changeset
124 TASK_VALUE : INTEGER := 0;
kono
parents:
diff changeset
125 ACCEPTING_ENTRIES : BOOLEAN := TRUE;
kono
parents:
diff changeset
126 BEGIN
kono
parents:
diff changeset
127 WHILE ACCEPTING_ENTRIES LOOP
kono
parents:
diff changeset
128 SELECT
kono
parents:
diff changeset
129 ACCEPT ASSIGN (J : IN INTEGER) DO
kono
parents:
diff changeset
130 TASK_VALUE := J;
kono
parents:
diff changeset
131 END ASSIGN;
kono
parents:
diff changeset
132 OR
kono
parents:
diff changeset
133 ACCEPT VALU (J : OUT INTEGER) DO
kono
parents:
diff changeset
134 J := TASK_VALUE;
kono
parents:
diff changeset
135 END VALU;
kono
parents:
diff changeset
136 OR
kono
parents:
diff changeset
137 ACCEPT NEXT DO
kono
parents:
diff changeset
138 TASK_VALUE := TASK_VALUE + 1;
kono
parents:
diff changeset
139 END NEXT;
kono
parents:
diff changeset
140 OR
kono
parents:
diff changeset
141 ACCEPT STOP DO
kono
parents:
diff changeset
142 ACCEPTING_ENTRIES := FALSE;
kono
parents:
diff changeset
143 END STOP;
kono
parents:
diff changeset
144 END SELECT;
kono
parents:
diff changeset
145 END LOOP;
kono
parents:
diff changeset
146 END TASK1;
kono
parents:
diff changeset
147
kono
parents:
diff changeset
148 BEGIN
kono
parents:
diff changeset
149 TEST ("C85005E", "CHECK THAT A VARIABLE CREATED BY AN ALLOCATOR " &
kono
parents:
diff changeset
150 "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
kono
parents:
diff changeset
151 "THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT" &
kono
parents:
diff changeset
152 " STATEMENT AND PASSED ON AS AN ACTUAL " &
kono
parents:
diff changeset
153 "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
kono
parents:
diff changeset
154 "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
kono
parents:
diff changeset
155 "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
kono
parents:
diff changeset
156 "RENAMED VARIABLE IS CHANGED, THE NEW VALUE " &
kono
parents:
diff changeset
157 "IS REFLECTED BY THE VALUE OF THE NEW NAME");
kono
parents:
diff changeset
158
kono
parents:
diff changeset
159 DECLARE
kono
parents:
diff changeset
160 TYPE ACCINT IS ACCESS INTEGER;
kono
parents:
diff changeset
161 TYPE ACCARR IS ACCESS ARRAY1;
kono
parents:
diff changeset
162 TYPE ACCREC IS ACCESS RECORD1;
kono
parents:
diff changeset
163 TYPE ACCPTR IS ACCESS POINTER1;
kono
parents:
diff changeset
164 TYPE ACCPVT IS ACCESS PACK1.PRIVY;
kono
parents:
diff changeset
165 TYPE ACCTSK IS ACCESS TASK1;
kono
parents:
diff changeset
166
kono
parents:
diff changeset
167 AI1 : ACCINT := NEW INTEGER'(0);
kono
parents:
diff changeset
168 AA1 : ACCARR := NEW ARRAY1'(0, 0, 0);
kono
parents:
diff changeset
169 AR1 : ACCREC := NEW RECORD1'(D => 1, FIELD1 => 0);
kono
parents:
diff changeset
170 AP1 : ACCPTR := NEW POINTER1'(NEW INTEGER'(0));
kono
parents:
diff changeset
171 AV1 : ACCPVT := NEW PACK1.PRIVY'(PACK1.ZERO);
kono
parents:
diff changeset
172 AT1 : ACCTSK := NEW TASK1;
kono
parents:
diff changeset
173
kono
parents:
diff changeset
174 XAI1 : INTEGER RENAMES AI1.ALL;
kono
parents:
diff changeset
175 XAA1 : ARRAY1 RENAMES AA1.ALL;
kono
parents:
diff changeset
176 XAR1 : RECORD1 RENAMES AR1.ALL;
kono
parents:
diff changeset
177 XAP1 : POINTER1 RENAMES AP1.ALL;
kono
parents:
diff changeset
178 XAV1 : PACK1.PRIVY RENAMES AV1.ALL;
kono
parents:
diff changeset
179 XAK1 : INTEGER RENAMES PACK1.AK1.ALL;
kono
parents:
diff changeset
180 XAT1 : TASK1 RENAMES AT1.ALL;
kono
parents:
diff changeset
181
kono
parents:
diff changeset
182 TASK TYPE TASK2 IS
kono
parents:
diff changeset
183 ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
kono
parents:
diff changeset
184 TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
kono
parents:
diff changeset
185 TV1 : IN OUT PACK1.PRIVY;
kono
parents:
diff changeset
186 TT1 : IN OUT TASK1; TK1 : IN OUT INTEGER);
kono
parents:
diff changeset
187 END TASK2;
kono
parents:
diff changeset
188
kono
parents:
diff changeset
189 I : INTEGER;
kono
parents:
diff changeset
190 A_CHK_TASK : TASK2;
kono
parents:
diff changeset
191
kono
parents:
diff changeset
192 PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
kono
parents:
diff changeset
193 PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
kono
parents:
diff changeset
194 PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
kono
parents:
diff changeset
195 PK1 : OUT INTEGER) IS
kono
parents:
diff changeset
196
kono
parents:
diff changeset
197 BEGIN
kono
parents:
diff changeset
198 PI1 := PI1 + 1;
kono
parents:
diff changeset
199 PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
kono
parents:
diff changeset
200 PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
kono
parents:
diff changeset
201 PP1 := NEW INTEGER'(AP1.ALL.ALL + 1);
kono
parents:
diff changeset
202 PV1 := PACK1.NEXT(AV1.ALL);
kono
parents:
diff changeset
203 PT1.NEXT;
kono
parents:
diff changeset
204 PK1 := PACK1.AK1.ALL + 1;
kono
parents:
diff changeset
205 END PROC1;
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 TASK BODY TASK2 IS
kono
parents:
diff changeset
208 BEGIN
kono
parents:
diff changeset
209 ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
kono
parents:
diff changeset
210 TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
kono
parents:
diff changeset
211 TV1 : IN OUT PACK1.PRIVY;
kono
parents:
diff changeset
212 TT1 : IN OUT TASK1;
kono
parents:
diff changeset
213 TK1 : IN OUT INTEGER) DO
kono
parents:
diff changeset
214 TI1 := AI1.ALL + 1;
kono
parents:
diff changeset
215 TA1 := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
kono
parents:
diff changeset
216 TR1 := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
kono
parents:
diff changeset
217 TP1 := NEW INTEGER'(TP1.ALL + 1);
kono
parents:
diff changeset
218 TV1 := PACK1.NEXT(TV1);
kono
parents:
diff changeset
219 TT1.NEXT;
kono
parents:
diff changeset
220 TK1 := TK1 + 1;
kono
parents:
diff changeset
221 END ENTRY1;
kono
parents:
diff changeset
222 END TASK2;
kono
parents:
diff changeset
223
kono
parents:
diff changeset
224 PACKAGE GENPACK2 IS NEW
kono
parents:
diff changeset
225 GENERIC1 (XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
kono
parents:
diff changeset
226
kono
parents:
diff changeset
227 BEGIN
kono
parents:
diff changeset
228 IF XAI1 /= IDENT_INT(1) THEN
kono
parents:
diff changeset
229 FAILED ("INCORRECT VALUE OF XAI1 (1)");
kono
parents:
diff changeset
230 END IF;
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232 IF XAA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
kono
parents:
diff changeset
233 FAILED ("INCORRECT VALUE OF XAA1 (1)");
kono
parents:
diff changeset
234 END IF;
kono
parents:
diff changeset
235
kono
parents:
diff changeset
236 IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
kono
parents:
diff changeset
237 FAILED ("INCORRECT VALUE OF XAR1 (1)");
kono
parents:
diff changeset
238 END IF;
kono
parents:
diff changeset
239
kono
parents:
diff changeset
240 IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(1) THEN
kono
parents:
diff changeset
241 FAILED ("INCORRECT VALUE OF XAP1 (1)");
kono
parents:
diff changeset
242 END IF;
kono
parents:
diff changeset
243
kono
parents:
diff changeset
244 IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.ONE)) THEN
kono
parents:
diff changeset
245 FAILED ("INCORRECT VALUE OF XAV1 (1)");
kono
parents:
diff changeset
246 END IF;
kono
parents:
diff changeset
247
kono
parents:
diff changeset
248 XAT1.VALU(I);
kono
parents:
diff changeset
249 IF I /= IDENT_INT(1) THEN
kono
parents:
diff changeset
250 FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (1)");
kono
parents:
diff changeset
251 END IF;
kono
parents:
diff changeset
252
kono
parents:
diff changeset
253 IF XAK1 /= IDENT_INT(1) THEN
kono
parents:
diff changeset
254 FAILED ("INCORRECT VALUE OF XAK1 (1)");
kono
parents:
diff changeset
255 END IF;
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 PROC1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
kono
parents:
diff changeset
258
kono
parents:
diff changeset
259 IF XAI1 /= IDENT_INT(2) THEN
kono
parents:
diff changeset
260 FAILED ("INCORRECT VALUE OF XAI1 (2)");
kono
parents:
diff changeset
261 END IF;
kono
parents:
diff changeset
262
kono
parents:
diff changeset
263 IF XAA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
kono
parents:
diff changeset
264 FAILED ("INCORRECT VALUE OF XAA1 (2)");
kono
parents:
diff changeset
265 END IF;
kono
parents:
diff changeset
266
kono
parents:
diff changeset
267 IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
kono
parents:
diff changeset
268 FAILED ("INCORRECT VALUE OF XAR1 (2)");
kono
parents:
diff changeset
269 END IF;
kono
parents:
diff changeset
270
kono
parents:
diff changeset
271 IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(2) THEN
kono
parents:
diff changeset
272 FAILED ("INCORRECT VALUE OF XAP1 (2)");
kono
parents:
diff changeset
273 END IF;
kono
parents:
diff changeset
274
kono
parents:
diff changeset
275 IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.TWO)) THEN
kono
parents:
diff changeset
276 FAILED ("INCORRECT VALUE OF XAV1 (2)");
kono
parents:
diff changeset
277 END IF;
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 XAT1.VALU(I);
kono
parents:
diff changeset
280 IF I /= IDENT_INT(2) THEN
kono
parents:
diff changeset
281 FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (2)");
kono
parents:
diff changeset
282 END IF;
kono
parents:
diff changeset
283
kono
parents:
diff changeset
284 IF XAK1 /= IDENT_INT(2) THEN
kono
parents:
diff changeset
285 FAILED ("INCORRECT VALUE OF XAK1 (2)");
kono
parents:
diff changeset
286 END IF;
kono
parents:
diff changeset
287
kono
parents:
diff changeset
288 A_CHK_TASK.ENTRY1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
kono
parents:
diff changeset
289
kono
parents:
diff changeset
290 IF XAI1 /= IDENT_INT(3) THEN
kono
parents:
diff changeset
291 FAILED ("INCORRECT VALUE OF XAI1 (3)");
kono
parents:
diff changeset
292 END IF;
kono
parents:
diff changeset
293
kono
parents:
diff changeset
294 IF XAA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
kono
parents:
diff changeset
295 FAILED ("INCORRECT VALUE OF XAA1 (3)");
kono
parents:
diff changeset
296 END IF;
kono
parents:
diff changeset
297
kono
parents:
diff changeset
298 IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
kono
parents:
diff changeset
299 FAILED ("INCORRECT VALUE OF XAR1 (3)");
kono
parents:
diff changeset
300 END IF;
kono
parents:
diff changeset
301
kono
parents:
diff changeset
302 IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(3) THEN
kono
parents:
diff changeset
303 FAILED ("INCORRECT VALUE OF XAP1 (3)");
kono
parents:
diff changeset
304 END IF;
kono
parents:
diff changeset
305
kono
parents:
diff changeset
306 IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.THREE)) THEN
kono
parents:
diff changeset
307 FAILED ("INCORRECT VALUE OF XAV1 (3)");
kono
parents:
diff changeset
308 END IF;
kono
parents:
diff changeset
309
kono
parents:
diff changeset
310 XAT1.VALU(I);
kono
parents:
diff changeset
311 IF I /= IDENT_INT(3) THEN
kono
parents:
diff changeset
312 FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (3)");
kono
parents:
diff changeset
313 END IF;
kono
parents:
diff changeset
314
kono
parents:
diff changeset
315 IF XAK1 /= IDENT_INT(3) THEN
kono
parents:
diff changeset
316 FAILED ("INCORRECT VALUE OF XAK1 (3)");
kono
parents:
diff changeset
317 END IF;
kono
parents:
diff changeset
318
kono
parents:
diff changeset
319 XAI1 := XAI1 + 1;
kono
parents:
diff changeset
320 XAA1 := (XAA1(1)+1, XAA1(2)+1, XAA1(3)+1);
kono
parents:
diff changeset
321 XAR1 := (D => 1, FIELD1 => XAR1.FIELD1 + 1);
kono
parents:
diff changeset
322 XAP1 := NEW INTEGER'(XAP1.ALL + 1);
kono
parents:
diff changeset
323 XAV1 := PACK1.NEXT(XAV1);
kono
parents:
diff changeset
324 XAT1.NEXT;
kono
parents:
diff changeset
325 XAK1 := XAK1 + 1;
kono
parents:
diff changeset
326
kono
parents:
diff changeset
327 IF XAI1 /= IDENT_INT(4) THEN
kono
parents:
diff changeset
328 FAILED ("INCORRECT VALUE OF XAI1 (4)");
kono
parents:
diff changeset
329 END IF;
kono
parents:
diff changeset
330
kono
parents:
diff changeset
331 IF XAA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
kono
parents:
diff changeset
332 FAILED ("INCORRECT VALUE OF XAA1 (4)");
kono
parents:
diff changeset
333 END IF;
kono
parents:
diff changeset
334
kono
parents:
diff changeset
335 IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
kono
parents:
diff changeset
336 FAILED ("INCORRECT VALUE OF XAR1 (4)");
kono
parents:
diff changeset
337 END IF;
kono
parents:
diff changeset
338
kono
parents:
diff changeset
339 IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(4) THEN
kono
parents:
diff changeset
340 FAILED ("INCORRECT VALUE OF XAP1 (4)");
kono
parents:
diff changeset
341 END IF;
kono
parents:
diff changeset
342
kono
parents:
diff changeset
343 IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FOUR)) THEN
kono
parents:
diff changeset
344 FAILED ("INCORRECT VALUE OF XAV1 (4)");
kono
parents:
diff changeset
345 END IF;
kono
parents:
diff changeset
346
kono
parents:
diff changeset
347 XAT1.VALU(I);
kono
parents:
diff changeset
348 IF I /= IDENT_INT(4) THEN
kono
parents:
diff changeset
349 FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (4)");
kono
parents:
diff changeset
350 END IF;
kono
parents:
diff changeset
351
kono
parents:
diff changeset
352 IF XAK1 /= IDENT_INT(4) THEN
kono
parents:
diff changeset
353 FAILED ("INCORRECT VALUE OF XAK1 (4)");
kono
parents:
diff changeset
354 END IF;
kono
parents:
diff changeset
355
kono
parents:
diff changeset
356 AI1.ALL := AI1.ALL + 1;
kono
parents:
diff changeset
357 AA1.ALL := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
kono
parents:
diff changeset
358 AR1.ALL := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
kono
parents:
diff changeset
359 AP1.ALL := NEW INTEGER'(AP1.ALL.ALL + 1);
kono
parents:
diff changeset
360 AV1.ALL := PACK1.NEXT(AV1.ALL);
kono
parents:
diff changeset
361 AT1.NEXT;
kono
parents:
diff changeset
362 PACK1.AK1.ALL := PACK1.AK1.ALL + 1;
kono
parents:
diff changeset
363
kono
parents:
diff changeset
364 IF XAI1 /= IDENT_INT(5) THEN
kono
parents:
diff changeset
365 FAILED ("INCORRECT VALUE OF XAI1 (5)");
kono
parents:
diff changeset
366 END IF;
kono
parents:
diff changeset
367
kono
parents:
diff changeset
368 IF XAA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
kono
parents:
diff changeset
369 FAILED ("INCORRECT VALUE OF XAA1 (5)");
kono
parents:
diff changeset
370 END IF;
kono
parents:
diff changeset
371
kono
parents:
diff changeset
372 IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
kono
parents:
diff changeset
373 FAILED ("INCORRECT VALUE OF XAR1 (5)");
kono
parents:
diff changeset
374 END IF;
kono
parents:
diff changeset
375
kono
parents:
diff changeset
376 IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(5) THEN
kono
parents:
diff changeset
377 FAILED ("INCORRECT VALUE OF XAP1 (5)");
kono
parents:
diff changeset
378 END IF;
kono
parents:
diff changeset
379
kono
parents:
diff changeset
380 IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FIVE)) THEN
kono
parents:
diff changeset
381 FAILED ("INCORRECT VALUE OF XAV1 (5)");
kono
parents:
diff changeset
382 END IF;
kono
parents:
diff changeset
383
kono
parents:
diff changeset
384 XAT1.VALU(I);
kono
parents:
diff changeset
385 IF I /= IDENT_INT(5) THEN
kono
parents:
diff changeset
386 FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (5)");
kono
parents:
diff changeset
387 END IF;
kono
parents:
diff changeset
388
kono
parents:
diff changeset
389 IF XAK1 /= IDENT_INT(5) THEN
kono
parents:
diff changeset
390 FAILED ("INCORRECT VALUE OF XAK1 (5)");
kono
parents:
diff changeset
391 END IF;
kono
parents:
diff changeset
392
kono
parents:
diff changeset
393 AT1.STOP;
kono
parents:
diff changeset
394 END;
kono
parents:
diff changeset
395
kono
parents:
diff changeset
396 RESULT;
kono
parents:
diff changeset
397 END C85005E;