Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c8/c85006c.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C85006C.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 COMPONENT OR SLICE OF A VARIABLE CREATED BY AN ENTRY
27 -- 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE CORRECT
28 -- VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
29 -- STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY
30 -- 'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT'
31 -- PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS
32 -- CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
33
34 -- HISTORY:
35 -- JET 03/22/88 CREATED ORIGINAL TEST.
36
37 WITH REPORT; USE REPORT;
38 PROCEDURE C85006C 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 TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
75 TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
76 TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
77 TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
78 TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
79 TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
80
81 TYPE REC_TYPE IS RECORD
82 RI1 : INTEGER := 0;
83 RA1 : ARRAY1(1..3) := (OTHERS => 0);
84 RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
85 RP1 : POINTER1 := NEW INTEGER'(0);
86 RV1 : PACK1.PRIVY := PACK1.ZERO;
87 RT1 : TASK1;
88 END RECORD;
89
90 DREC : REC_TYPE;
91
92 DAI1 : ARR_INT(1..8) := (OTHERS => 0);
93 DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
94 DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
95 DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
96 DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
97 DAT1 : ARR_TSK(1..8);
98
99 I : INTEGER;
100
101 GENERIC
102 GRI1 : IN OUT INTEGER;
103 GRA1 : IN OUT ARRAY1;
104 GRR1 : IN OUT RECORD1;
105 GRP1 : IN OUT POINTER1;
106 GRV1 : IN OUT PACK1.PRIVY;
107 GRT1 : IN OUT TASK1;
108 GAI1 : IN OUT ARR_INT;
109 GAA1 : IN OUT ARR_ARR;
110 GAR1 : IN OUT ARR_REC;
111 GAP1 : IN OUT ARR_PTR;
112 GAV1 : IN OUT ARR_PVT;
113 GAT1 : IN OUT ARR_TSK;
114 PACKAGE GENERIC1 IS
115 END GENERIC1;
116
117 FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
118 BEGIN
119 IF EQUAL (3,3) THEN
120 RETURN P;
121 ELSE
122 RETURN NULL;
123 END IF;
124 END IDENT;
125
126 PACKAGE BODY PACK1 IS
127 FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
128 BEGIN
129 IF EQUAL(3,3) THEN
130 RETURN I;
131 ELSE
132 RETURN PRIVY'(0);
133 END IF;
134 END IDENT;
135
136 FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
137 BEGIN
138 RETURN I+1;
139 END NEXT;
140 END PACK1;
141
142 PACKAGE BODY GENERIC1 IS
143 BEGIN
144 GRI1 := GRI1 + 1;
145 GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
146 GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
147 GRP1 := NEW INTEGER'(GRP1.ALL + 1);
148 GRV1 := PACK1.NEXT(GRV1);
149 GRT1.NEXT;
150 GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
151 GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
152 GAR1 := (OTHERS => (D => 1,
153 FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
154 GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
155 FOR J IN GAV1'RANGE LOOP
156 GAV1(J) := PACK1.NEXT(GAV1(J));
157 END LOOP;
158 FOR J IN GAT1'RANGE LOOP
159 GAT1(J).NEXT;
160 END LOOP;
161 END GENERIC1;
162
163 TASK BODY TASK1 IS
164 TASK_VALUE : INTEGER := 0;
165 ACCEPTING_ENTRIES : BOOLEAN := TRUE;
166 BEGIN
167 WHILE ACCEPTING_ENTRIES LOOP
168 SELECT
169 ACCEPT ASSIGN (J : IN INTEGER) DO
170 TASK_VALUE := J;
171 END ASSIGN;
172 OR
173 ACCEPT VALU (J : OUT INTEGER) DO
174 J := TASK_VALUE;
175 END VALU;
176 OR
177 ACCEPT NEXT DO
178 TASK_VALUE := TASK_VALUE + 1;
179 END NEXT;
180 OR
181 ACCEPT STOP DO
182 ACCEPTING_ENTRIES := FALSE;
183 END STOP;
184 END SELECT;
185 END LOOP;
186 END TASK1;
187
188 BEGIN
189 TEST ("C85006C", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
190 "CREATED BY AN ENTRY 'IN OUT' FORMAL PARAMETER " &
191 "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
192 "THAT THE NEW NAME CAN BE USED IN AN ASSIGN" &
193 "MENT STATEMENT AND PASSED ON AS AN ACTUAL " &
194 "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
195 "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
196 "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
197 "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
198 "REFLECTED BY THE VALUE OF THE NEW NAME");
199
200 DECLARE
201 TASK MAIN_TASK IS
202 ENTRY START (REC : IN OUT REC_TYPE;
203 AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
204 AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
205 AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK);
206 END MAIN_TASK;
207
208 TASK BODY MAIN_TASK IS
209 BEGIN
210 ACCEPT START (REC : IN OUT REC_TYPE;
211 AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
212 AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
213 AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK)
214 DO
215 DECLARE
216 XRI1 : INTEGER RENAMES REC.RI1;
217 XRA1 : ARRAY1 RENAMES REC.RA1;
218 XRR1 : RECORD1 RENAMES REC.RR1;
219 XRP1 : POINTER1 RENAMES REC.RP1;
220 XRV1 : PACK1.PRIVY RENAMES REC.RV1;
221 XRT1 : TASK1 RENAMES REC.RT1;
222 XAI1 : ARR_INT RENAMES AI1(1..3);
223 XAA1 : ARR_ARR RENAMES AA1(2..4);
224 XAR1 : ARR_REC RENAMES AR1(3..5);
225 XAP1 : ARR_PTR RENAMES AP1(4..6);
226 XAV1 : ARR_PVT RENAMES AV1(5..7);
227 XAT1 : ARR_TSK RENAMES AT1(6..8);
228
229 TASK TYPE TASK2 IS
230 ENTRY ENTRY1 (TRI1 : OUT INTEGER;
231 TRA1 : OUT ARRAY1;
232 TRR1 : OUT RECORD1;
233 TRP1 : IN OUT POINTER1;
234 TRV1 : IN OUT PACK1.PRIVY;
235 TRT1 : IN OUT TASK1;
236 TAI1 : OUT ARR_INT;
237 TAA1 : OUT ARR_ARR;
238 TAR1 : OUT ARR_REC;
239 TAP1 : IN OUT ARR_PTR;
240 TAV1 : IN OUT ARR_PVT;
241 TAT1 : IN OUT ARR_TSK);
242 END TASK2;
243
244 CHK_TASK : TASK2;
245
246 TASK BODY TASK2 IS
247 BEGIN
248 ACCEPT ENTRY1 (TRI1 : OUT INTEGER;
249 TRA1 : OUT ARRAY1;
250 TRR1 : OUT RECORD1;
251 TRP1 : IN OUT POINTER1;
252 TRV1 : IN OUT PACK1.PRIVY;
253 TRT1: IN OUT TASK1;
254 TAI1 : OUT ARR_INT;
255 TAA1 : OUT ARR_ARR;
256 TAR1 : OUT ARR_REC;
257 TAP1 : IN OUT ARR_PTR;
258 TAV1 : IN OUT ARR_PVT;
259 TAT1 : IN OUT ARR_TSK)
260 DO
261 TRI1 := REC.RI1 + 1;
262 TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
263 REC.RA1(3)+1);
264 TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
265 TRP1 := NEW INTEGER'(TRP1.ALL + 1);
266 TRV1 := PACK1.NEXT(TRV1);
267 TRT1.NEXT;
268 TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
269 TAA1 := (OTHERS => (OTHERS =>
270 AA1(TAA1'FIRST)(1) + 1));
271 TAR1 := (OTHERS => (D => 1, FIELD1 =>
272 (AR1(TAR1'FIRST).FIELD1 + 1)));
273 TAP1 := (OTHERS =>
274 NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
275 FOR J IN TAV1'RANGE LOOP
276 TAV1(J) := PACK1.NEXT(TAV1(J));
277 END LOOP;
278 FOR J IN TAT1'RANGE LOOP
279 TAT1(J).NEXT;
280 END LOOP;
281 END ENTRY1;
282 END TASK2;
283
284 PROCEDURE PROC1 (PRI1 : IN OUT INTEGER;
285 PRA1 : IN OUT ARRAY1;
286 PRR1 : IN OUT RECORD1;
287 PRP1 : OUT POINTER1;
288 PRV1 : OUT PACK1.PRIVY;
289 PRT1 : IN OUT TASK1;
290 PAI1 : IN OUT ARR_INT;
291 PAA1 : IN OUT ARR_ARR;
292 PAR1 : IN OUT ARR_REC;
293 PAP1 : OUT ARR_PTR;
294 PAV1 : OUT ARR_PVT;
295 PAT1 : IN OUT ARR_TSK) IS
296 BEGIN
297 PRI1 := PRI1 + 1;
298 PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
299 PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
300 PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
301 PRV1 := PACK1.NEXT(REC.RV1);
302 PRT1.NEXT;
303 PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
304 PAA1 := (OTHERS => (OTHERS =>
305 PAA1(PAA1'FIRST)(1) + 1));
306 PAR1 := (OTHERS => (D => 1, FIELD1 =>
307 (PAR1(PAR1'FIRST).FIELD1+1)));
308 PAP1 := (OTHERS =>
309 NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
310 FOR J IN PAV1'RANGE LOOP
311 PAV1(J) := PACK1.NEXT(AV1(J));
312 END LOOP;
313 FOR J IN PAT1'RANGE LOOP
314 PAT1(J).NEXT;
315 END LOOP;
316 END PROC1;
317
318 PACKAGE GENPACK2 IS NEW GENERIC1
319 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
320 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
321
322 BEGIN
323 IF XRI1 /= IDENT_INT(1) THEN
324 FAILED ("INCORRECT VALUE OF XRI1 (1)");
325 END IF;
326
327 IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),
328 IDENT_INT(1)) THEN
329 FAILED ("INCORRECT VALUE OF XRA1 (1)");
330 END IF;
331
332 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1))
333 THEN
334 FAILED ("INCORRECT VALUE OF XRR1 (1)");
335 END IF;
336
337 IF XRP1 /= IDENT(REC.RP1) OR
338 XRP1.ALL /= IDENT_INT(1) THEN
339 FAILED ("INCORRECT VALUE OF XRP1 (1)");
340 END IF;
341
342 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE))
343 THEN
344 FAILED ("INCORRECT VALUE OF XRV1 (1)");
345 END IF;
346
347 XRT1.VALU(I);
348 IF I /= IDENT_INT(1) THEN
349 FAILED ("INCORRECT RETURN VALUE OF " &
350 "XRT1.VALU (1)");
351 END IF;
352
353 FOR J IN XAI1'RANGE LOOP
354 IF XAI1(J) /= IDENT_INT(1) THEN
355 FAILED ("INCORRECT VALUE OF XAI1(" &
356 INTEGER'IMAGE(J) & ") (1)");
357 END IF;
358 END LOOP;
359
360 FOR J IN XAA1'RANGE LOOP
361 IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),
362 IDENT_INT(1)) THEN
363 FAILED ("INCORRECT VALUE OF XAA1(" &
364 INTEGER'IMAGE(J) & ") (1)");
365 END IF;
366 END LOOP;
367
368 FOR J IN XAR1'RANGE LOOP
369 IF XAR1(J) /= (D => 1,
370 FIELD1 => IDENT_INT(1)) THEN
371 FAILED ("INCORRECT VALUE OF XAR1(" &
372 INTEGER'IMAGE(J) & ") (1)");
373 END IF;
374 END LOOP;
375
376 FOR J IN XAP1'RANGE LOOP
377 IF XAP1(J) /= IDENT(AP1(J)) OR
378 XAP1(J).ALL /= IDENT_INT(1) THEN
379 FAILED ("INCORRECT VALUE OF XAP1(" &
380 INTEGER'IMAGE(J) & ") (1)");
381 END IF;
382 END LOOP;
383
384 FOR J IN XAV1'RANGE LOOP
385 IF PACK1."/=" (XAV1(J),
386 PACK1.IDENT(PACK1.ONE)) THEN
387 FAILED ("INCORRECT VALUE OF XAV1(" &
388 INTEGER'IMAGE(J) & ") (1)");
389 END IF;
390 END LOOP;
391
392 FOR J IN XAT1'RANGE LOOP
393 XAT1(J).VALU(I);
394 IF I /= IDENT_INT(1) THEN
395 FAILED ("INCORRECT RETURN VALUE " &
396 "FROM XAT1(" & INTEGER'IMAGE(J) &
397 ").VALU (1)");
398 END IF;
399 END LOOP;
400
401 PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
402 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
403
404 IF XRI1 /= IDENT_INT(2) THEN
405 FAILED ("INCORRECT VALUE OF XRI1 (2)");
406 END IF;
407
408 IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),
409 IDENT_INT(2)) THEN
410 FAILED ("INCORRECT VALUE OF XRA1 (2)");
411 END IF;
412
413 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2))
414 THEN
415 FAILED ("INCORRECT VALUE OF XRR1 (2)");
416 END IF;
417
418 IF XRP1 /= IDENT(REC.RP1) OR
419 XRP1.ALL /= IDENT_INT(2) THEN
420 FAILED ("INCORRECT VALUE OF XRP1 (2)");
421 END IF;
422
423 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO))
424 THEN
425 FAILED ("INCORRECT VALUE OF XRV1 (2)");
426 END IF;
427
428 XRT1.VALU(I);
429 IF I /= IDENT_INT(2) THEN
430 FAILED ("INCORRECT RETURN VALUE FROM " &
431 "XRT1.VALU (2)");
432 END IF;
433
434 FOR J IN XAI1'RANGE LOOP
435 IF XAI1(J) /= IDENT_INT(2) THEN
436 FAILED ("INCORRECT VALUE OF XAI1(" &
437 INTEGER'IMAGE(J) & ") (2)");
438 END IF;
439 END LOOP;
440
441 FOR J IN XAA1'RANGE LOOP
442 IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),
443 IDENT_INT(2)) THEN
444 FAILED ("INCORRECT VALUE OF XAA1(" &
445 INTEGER'IMAGE(J) & ") (2)");
446 END IF;
447 END LOOP;
448
449 FOR J IN XAR1'RANGE LOOP
450 IF XAR1(J) /= (D => 1,
451 FIELD1 => IDENT_INT(2)) THEN
452 FAILED ("INCORRECT VALUE OF XAR1(" &
453 INTEGER'IMAGE(J) & ") (2)");
454 END IF;
455 END LOOP;
456
457 FOR J IN XAP1'RANGE LOOP
458 IF XAP1(J) /= IDENT(AP1(J)) OR
459 XAP1(J).ALL /= IDENT_INT(2) THEN
460 FAILED ("INCORRECT VALUE OF XAP1(" &
461 INTEGER'IMAGE(J) & ") (2)");
462 END IF;
463 END LOOP;
464
465 FOR J IN XAV1'RANGE LOOP
466 IF PACK1."/=" (XAV1(J),
467 PACK1.IDENT(PACK1.TWO)) THEN
468 FAILED ("INCORRECT VALUE OF XAV1(" &
469 INTEGER'IMAGE(J) & ") (2)");
470 END IF;
471 END LOOP;
472
473 FOR J IN XAT1'RANGE LOOP
474 XAT1(J).VALU(I);
475 IF I /= IDENT_INT(2) THEN
476 FAILED ("INCORRECT RETURN VALUE " &
477 "FROM XAT1(" & INTEGER'IMAGE(J) &
478 ").VALU (2)");
479 END IF;
480 END LOOP;
481
482 CHK_TASK.ENTRY1
483 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
484 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
485
486 IF XRI1 /= IDENT_INT(3) THEN
487 FAILED ("INCORRECT VALUE OF XRI1 (3)");
488 END IF;
489
490 IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),
491 IDENT_INT(3)) THEN
492 FAILED ("INCORRECT VALUE OF XRA1 (3)");
493 END IF;
494
495 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3))
496 THEN
497 FAILED ("INCORRECT VALUE OF XRR1 (3)");
498 END IF;
499
500 IF XRP1 /= IDENT(REC.RP1) OR
501 XRP1.ALL /= IDENT_INT(3) THEN
502 FAILED ("INCORRECT VALUE OF XRP1 (3)");
503 END IF;
504
505 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE))
506 THEN
507 FAILED ("INCORRECT VALUE OF XRV1 (3)");
508 END IF;
509
510 XRT1.VALU(I);
511 IF I /= IDENT_INT(3) THEN
512 FAILED ("INCORRECT RETURN VALUE OF " &
513 "XRT1.VALU (3)");
514 END IF;
515
516 FOR J IN XAI1'RANGE LOOP
517 IF XAI1(J) /= IDENT_INT(3) THEN
518 FAILED ("INCORRECT VALUE OF XAI1(" &
519 INTEGER'IMAGE(J) & ") (3)");
520 END IF;
521 END LOOP;
522
523 FOR J IN XAA1'RANGE LOOP
524 IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),
525 IDENT_INT(3))
526 THEN
527 FAILED ("INCORRECT VALUE OF XAA1(" &
528 INTEGER'IMAGE(J) & ") (3)");
529 END IF;
530 END LOOP;
531
532 FOR J IN XAR1'RANGE LOOP
533 IF XAR1(J) /= (D => 1,
534 FIELD1 => IDENT_INT(3)) THEN
535 FAILED ("INCORRECT VALUE OF XAR1(" &
536 INTEGER'IMAGE(J) & ") (3)");
537 END IF;
538 END LOOP;
539
540 FOR J IN XAP1'RANGE LOOP
541 IF XAP1(J) /= IDENT(AP1(J)) OR
542 XAP1(J).ALL /= IDENT_INT(3) THEN
543 FAILED ("INCORRECT VALUE OF XAP1(" &
544 INTEGER'IMAGE(J) & ") (3)");
545 END IF;
546 END LOOP;
547
548 FOR J IN XAV1'RANGE LOOP
549 IF PACK1."/=" (XAV1(J),
550 PACK1.IDENT(PACK1.THREE)) THEN
551 FAILED ("INCORRECT VALUE OF XAV1(" &
552 INTEGER'IMAGE(J) & ") (3)");
553 END IF;
554 END LOOP;
555
556 FOR J IN XAT1'RANGE LOOP
557 XAT1(J).VALU(I);
558 IF I /= IDENT_INT(3) THEN
559 FAILED ("INCORRECT RETURN VALUE " &
560 "FROM XAT1(" &
561 INTEGER'IMAGE(J) & ").VALU (3)");
562 END IF;
563 END LOOP;
564
565 XRI1 := XRI1 + 1;
566 XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
567 XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
568 XRP1 := NEW INTEGER'(XRP1.ALL + 1);
569 XRV1 := PACK1.NEXT(XRV1);
570 XRT1.NEXT;
571 XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
572 XAA1 := (OTHERS =>
573 (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
574 XAR1 := (OTHERS => (D => 1, FIELD1 =>
575 (XAR1(XAR1'FIRST).FIELD1 + 1)));
576 XAP1 := (OTHERS =>
577 NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
578 FOR J IN XAV1'RANGE LOOP
579 XAV1(J) := PACK1.NEXT(XAV1(J));
580 END LOOP;
581 FOR J IN XAT1'RANGE LOOP
582 XAT1(J).NEXT;
583 END LOOP;
584
585 IF XRI1 /= IDENT_INT(4) THEN
586 FAILED ("INCORRECT VALUE OF XRI1 (4)");
587 END IF;
588
589 IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),
590 IDENT_INT(4)) THEN
591 FAILED ("INCORRECT VALUE OF XRA1 (4)");
592 END IF;
593
594 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4))
595 THEN
596 FAILED ("INCORRECT VALUE OF XRR1 (4)");
597 END IF;
598
599 IF XRP1 /= IDENT(REC.RP1) OR
600 XRP1.ALL /= IDENT_INT(4) THEN
601 FAILED ("INCORRECT VALUE OF XRP1 (4)");
602 END IF;
603
604 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR))
605 THEN
606 FAILED ("INCORRECT VALUE OF XRV1 (4)");
607 END IF;
608
609 XRT1.VALU(I);
610 IF I /= IDENT_INT(4) THEN
611 FAILED ("INCORRECT RETURN VALUE OF " &
612 "XRT1.VALU (4)");
613 END IF;
614
615 FOR J IN XAI1'RANGE LOOP
616 IF XAI1(J) /= IDENT_INT(4) THEN
617 FAILED ("INCORRECT VALUE OF XAI1(" &
618 INTEGER'IMAGE(J) & ") (4)");
619 END IF;
620 END LOOP;
621
622 FOR J IN XAA1'RANGE LOOP
623 IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),
624 IDENT_INT(4)) THEN
625 FAILED ("INCORRECT VALUE OF XAA1(" &
626 INTEGER'IMAGE(J) & ") (4)");
627 END IF;
628 END LOOP;
629
630 FOR J IN XAR1'RANGE LOOP
631 IF XAR1(J) /= (D => 1, FIELD1 =>
632 IDENT_INT(4)) THEN
633 FAILED ("INCORRECT VALUE OF XAR1(" &
634 INTEGER'IMAGE(J) & ") (4)");
635 END IF;
636 END LOOP;
637
638 FOR J IN XAP1'RANGE LOOP
639 IF XAP1(J) /= IDENT(AP1(J)) OR
640 XAP1(J).ALL /= IDENT_INT(4) THEN
641 FAILED ("INCORRECT VALUE OF XAP1(" &
642 INTEGER'IMAGE(J) & ") (4)");
643 END IF;
644 END LOOP;
645
646 FOR J IN XAV1'RANGE LOOP
647 IF PACK1."/=" (XAV1(J),
648 PACK1.IDENT(PACK1.FOUR)) THEN
649 FAILED ("INCORRECT VALUE OF XAV1(" &
650 INTEGER'IMAGE(J) & ") (4)");
651 END IF;
652 END LOOP;
653
654 FOR J IN XAT1'RANGE LOOP
655 XAT1(J).VALU(I);
656 IF I /= IDENT_INT(4) THEN
657 FAILED ("INCORRECT RETURN VALUE " &
658 "FROM XAT1(" &
659 INTEGER'IMAGE(J) & ").VALU (4)");
660 END IF;
661 END LOOP;
662
663 REC.RI1 := REC.RI1 + 1;
664 REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
665 REC.RA1(3)+1);
666 REC.RR1 := (D => 1, FIELD1 =>
667 REC.RR1.FIELD1 + 1);
668 REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
669 REC.RV1 := PACK1.NEXT(REC.RV1);
670 REC.RT1.NEXT;
671 AI1(XAI1'RANGE) := (OTHERS =>
672 AI1(XAI1'FIRST) + 1);
673 AA1(XAA1'RANGE) := (OTHERS =>
674 (OTHERS => AA1(XAA1'FIRST)(1) + 1));
675 AR1(XAR1'RANGE) := (OTHERS => (D => 1,
676 FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
677 AP1(XAP1'RANGE) := (OTHERS =>
678 NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
679 FOR J IN XAV1'RANGE LOOP
680 AV1(J) := PACK1.NEXT(AV1(J));
681 END LOOP;
682 FOR J IN XAT1'RANGE LOOP
683 AT1(J).NEXT;
684 END LOOP;
685
686 IF XRI1 /= IDENT_INT(5) THEN
687 FAILED ("INCORRECT VALUE OF XRI1 (5)");
688 END IF;
689
690 IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),
691 IDENT_INT(5)) THEN
692 FAILED ("INCORRECT VALUE OF XRA1 (5)");
693 END IF;
694
695 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5))
696 THEN
697 FAILED ("INCORRECT VALUE OF XRR1 (5)");
698 END IF;
699
700 IF XRP1 /= IDENT(REC.RP1) OR
701 XRP1.ALL /= IDENT_INT(5) THEN
702 FAILED ("INCORRECT VALUE OF XRP1 (5)");
703 END IF;
704
705 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE))
706 THEN
707 FAILED ("INCORRECT VALUE OF XRV1 (5)");
708 END IF;
709
710 XRT1.VALU(I);
711 IF I /= IDENT_INT(5) THEN
712 FAILED ("INCORRECT RETURN VALUE OF " &
713 "XRT1.VALU (5)");
714 END IF;
715
716 FOR J IN XAI1'RANGE LOOP
717 IF XAI1(J) /= IDENT_INT(5) THEN
718 FAILED ("INCORRECT VALUE OF XAI1(" &
719 INTEGER'IMAGE(J) & ") (5)");
720 END IF;
721 END LOOP;
722
723 FOR J IN XAA1'RANGE LOOP
724 IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),
725 IDENT_INT(5)) THEN
726 FAILED ("INCORRECT VALUE OF XAA1(" &
727 INTEGER'IMAGE(J) & ") (5)");
728 END IF;
729 END LOOP;
730
731 FOR J IN XAR1'RANGE LOOP
732 IF XAR1(J) /= (D => 1, FIELD1 =>
733 IDENT_INT(5)) THEN
734 FAILED ("INCORRECT VALUE OF XAR1(" &
735 INTEGER'IMAGE(J) & ") (5)");
736 END IF;
737 END LOOP;
738
739 FOR J IN XAP1'RANGE LOOP
740 IF XAP1(J) /= IDENT(AP1(J)) OR
741 XAP1(J).ALL /= IDENT_INT(5) THEN
742 FAILED ("INCORRECT VALUE OF XAP1(" &
743 INTEGER'IMAGE(J) & ") (5)");
744 END IF;
745 END LOOP;
746
747 FOR J IN XAV1'RANGE LOOP
748 IF PACK1."/=" (XAV1(J),
749 PACK1.IDENT(PACK1.FIVE)) THEN
750 FAILED ("INCORRECT VALUE OF XAV1(" &
751 INTEGER'IMAGE(J) & ") (5)");
752 END IF;
753 END LOOP;
754
755 FOR J IN XAT1'RANGE LOOP
756 XAT1(J).VALU(I);
757 IF I /= IDENT_INT(5) THEN
758 FAILED ("INCORRECT RETURN VALUE " &
759 "FROM XAT1(" &
760 INTEGER'IMAGE(J) & ").VALU (5)");
761 END IF;
762 END LOOP;
763 END;
764 END START;
765 END MAIN_TASK;
766
767 BEGIN
768 MAIN_TASK.START (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
769 END;
770
771 DREC.RT1.STOP;
772
773 FOR I IN DAT1'RANGE LOOP
774 DAT1(I).STOP;
775 END LOOP;
776
777 RESULT;
778 END C85006C;