3 -- Grant of Unlimited Rights
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
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.
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.
35 -- JET 03/22/88 CREATED ORIGINAL TEST.
37 WITH REPORT
; USE REPORT
;
40 TYPE ARRAY1
IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
41 TYPE RECORD1
(D
: INTEGER) IS
43 FIELD1
: INTEGER := 1;
45 TYPE POINTER1
IS ACCESS INTEGER;
48 TYPE PRIVY
IS PRIVATE;
49 ZERO
: 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
;
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;
68 ENTRY ASSIGN
(J
: IN INTEGER);
69 ENTRY VALU
(J
: OUT INTEGER);
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
;
81 TYPE REC_TYPE
IS RECORD
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;
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
);
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
;
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
;
117 FUNCTION IDENT
(P
: POINTER1
) RETURN POINTER1
IS
126 PACKAGE BODY PACK1
IS
127 FUNCTION IDENT
(I
: PRIVY
) RETURN PRIVY
IS
136 FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
142 PACKAGE BODY GENERIC1 IS
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
);
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));
158 FOR J IN GAT1'RANGE LOOP
164 TASK_VALUE : INTEGER := 0;
165 ACCEPTING_ENTRIES : BOOLEAN := TRUE;
167 WHILE ACCEPTING_ENTRIES LOOP
169 ACCEPT ASSIGN (J : IN INTEGER) DO
173 ACCEPT VALU (J : OUT INTEGER) DO
178 TASK_VALUE := TASK_VALUE + 1;
182 ACCEPTING_ENTRIES := FALSE;
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");
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);
208 TASK BODY MAIN_TASK IS
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)
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);
230 ENTRY ENTRY1 (TRI1 : OUT INTEGER;
233 TRP1 : IN OUT POINTER1;
234 TRV1 : IN OUT PACK1.PRIVY;
239 TAP1 : IN OUT ARR_PTR;
240 TAV1 : IN OUT ARR_PVT;
241 TAT1 : IN OUT ARR_TSK);
248 ACCEPT ENTRY1 (TRI1 : OUT INTEGER;
251 TRP1 : IN OUT POINTER1;
252 TRV1 : IN OUT PACK1.PRIVY;
257 TAP1 : IN OUT ARR_PTR;
258 TAV1 : IN OUT ARR_PVT;
259 TAT1 : IN OUT ARR_TSK)
262 TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
264 TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
265 TRP1 := NEW INTEGER'(TRP1
.ALL + 1);
266 TRV1
:= PACK1
.NEXT
(TRV1
);
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)));
274 NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
275 FOR J IN TAV1'RANGE LOOP
276 TAV1(J) := PACK1.NEXT(TAV1(J));
278 FOR J IN TAT1'RANGE LOOP
284 PROCEDURE PROC1 (PRI1 : IN OUT INTEGER;
285 PRA1 : IN OUT ARRAY1;
286 PRR1 : IN OUT RECORD1;
288 PRV1 : OUT PACK1.PRIVY;
290 PAI1 : IN OUT ARR_INT;
291 PAA1 : IN OUT ARR_ARR;
292 PAR1 : IN OUT ARR_REC;
295 PAT1 : IN OUT ARR_TSK) IS
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
);
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)));
309 NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
310 FOR J IN PAV1'RANGE LOOP
311 PAV1(J) := PACK1.NEXT(AV1(J));
313 FOR J IN PAT1'RANGE LOOP
318 PACKAGE GENPACK2 IS NEW GENERIC1
319 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
320 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
323 IF XRI1 /= IDENT_INT(1) THEN
324 FAILED ("INCORRECT VALUE OF XRI1 (1)");
327 IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),
329 FAILED ("INCORRECT VALUE OF XRA1 (1)");
332 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1))
334 FAILED ("INCORRECT VALUE OF XRR1 (1)");
337 IF XRP1 /= IDENT(REC.RP1) OR
338 XRP1.ALL /= IDENT_INT(1) THEN
339 FAILED ("INCORRECT VALUE OF XRP1 (1)");
342 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE))
344 FAILED ("INCORRECT VALUE OF XRV1 (1)");
348 IF I /= IDENT_INT(1) THEN
349 FAILED ("INCORRECT RETURN VALUE OF " &
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)");
360 FOR J IN XAA1'RANGE LOOP
361 IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),
363 FAILED ("INCORRECT VALUE OF XAA1(" &
364 INTEGER'IMAGE(J) & ") (1)");
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)");
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)");
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)");
392 FOR J IN XAT1'RANGE LOOP
394 IF I /= IDENT_INT(1) THEN
395 FAILED ("INCORRECT RETURN VALUE " &
396 "FROM XAT1(" & INTEGER'IMAGE(J) &
401 PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
402 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
404 IF XRI1 /= IDENT_INT(2) THEN
405 FAILED ("INCORRECT VALUE OF XRI1 (2)");
408 IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),
410 FAILED ("INCORRECT VALUE OF XRA1 (2)");
413 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2))
415 FAILED ("INCORRECT VALUE OF XRR1 (2)");
418 IF XRP1 /= IDENT(REC.RP1) OR
419 XRP1.ALL /= IDENT_INT(2) THEN
420 FAILED ("INCORRECT VALUE OF XRP1 (2)");
423 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO))
425 FAILED ("INCORRECT VALUE OF XRV1 (2)");
429 IF I /= IDENT_INT(2) THEN
430 FAILED ("INCORRECT RETURN VALUE FROM " &
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)");
441 FOR J IN XAA1'RANGE LOOP
442 IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),
444 FAILED ("INCORRECT VALUE OF XAA1(" &
445 INTEGER'IMAGE(J) & ") (2)");
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)");
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)");
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)");
473 FOR J IN XAT1'RANGE LOOP
475 IF I /= IDENT_INT(2) THEN
476 FAILED ("INCORRECT RETURN VALUE " &
477 "FROM XAT1(" & INTEGER'IMAGE(J) &
483 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
484 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
486 IF XRI1 /= IDENT_INT(3) THEN
487 FAILED ("INCORRECT VALUE OF XRI1 (3)");
490 IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),
492 FAILED ("INCORRECT VALUE OF XRA1 (3)");
495 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3))
497 FAILED ("INCORRECT VALUE OF XRR1 (3)");
500 IF XRP1 /= IDENT(REC.RP1) OR
501 XRP1.ALL /= IDENT_INT(3) THEN
502 FAILED ("INCORRECT VALUE OF XRP1 (3)");
505 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE))
507 FAILED ("INCORRECT VALUE OF XRV1 (3)");
511 IF I /= IDENT_INT(3) THEN
512 FAILED ("INCORRECT RETURN VALUE OF " &
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)");
523 FOR J IN XAA1'RANGE LOOP
524 IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),
527 FAILED ("INCORRECT VALUE OF XAA1(" &
528 INTEGER'IMAGE(J) & ") (3)");
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)");
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)");
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)");
556 FOR J IN XAT1'RANGE LOOP
558 IF I /= IDENT_INT(3) THEN
559 FAILED ("INCORRECT RETURN VALUE " &
561 INTEGER'IMAGE(J) & ").VALU (3)");
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
);
571 XAI1
:= (OTHERS => XAI1
(XAI1
'FIRST) + 1);
573 (OTHERS => XAA1
(XAA1
'FIRST)(1) + 1));
574 XAR1
:= (OTHERS => (D
=> 1, FIELD1
=>
575 (XAR1
(XAR1
'FIRST).FIELD1
+ 1)));
577 NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
578 FOR J IN XAV1'RANGE LOOP
579 XAV1(J) := PACK1.NEXT(XAV1(J));
581 FOR J IN XAT1'RANGE LOOP
585 IF XRI1 /= IDENT_INT(4) THEN
586 FAILED ("INCORRECT VALUE OF XRI1 (4)");
589 IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),
591 FAILED ("INCORRECT VALUE OF XRA1 (4)");
594 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4))
596 FAILED ("INCORRECT VALUE OF XRR1 (4)");
599 IF XRP1 /= IDENT(REC.RP1) OR
600 XRP1.ALL /= IDENT_INT(4) THEN
601 FAILED ("INCORRECT VALUE OF XRP1 (4)");
604 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR))
606 FAILED ("INCORRECT VALUE OF XRV1 (4)");
610 IF I /= IDENT_INT(4) THEN
611 FAILED ("INCORRECT RETURN VALUE OF " &
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)");
622 FOR J IN XAA1'RANGE LOOP
623 IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),
625 FAILED ("INCORRECT VALUE OF XAA1(" &
626 INTEGER'IMAGE(J) & ") (4)");
630 FOR J IN XAR1'RANGE LOOP
631 IF XAR1(J) /= (D => 1, FIELD1 =>
633 FAILED ("INCORRECT VALUE OF XAR1(" &
634 INTEGER'IMAGE(J) & ") (4)");
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)");
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)");
654 FOR J IN XAT1'RANGE LOOP
656 IF I /= IDENT_INT(4) THEN
657 FAILED ("INCORRECT RETURN VALUE " &
659 INTEGER'IMAGE(J) & ").VALU (4)");
663 REC.RI1 := REC.RI1 + 1;
664 REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
666 REC.RR1 := (D => 1, FIELD1 =>
668 REC.RP1 := NEW INTEGER'(REC
.RP1
.ALL + 1);
669 REC
.RV1
:= PACK1
.NEXT
(REC
.RV1
);
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));
682 FOR J IN XAT1'RANGE LOOP
686 IF XRI1 /= IDENT_INT(5) THEN
687 FAILED ("INCORRECT VALUE OF XRI1 (5)");
690 IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),
692 FAILED ("INCORRECT VALUE OF XRA1 (5)");
695 IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5))
697 FAILED ("INCORRECT VALUE OF XRR1 (5)");
700 IF XRP1 /= IDENT(REC.RP1) OR
701 XRP1.ALL /= IDENT_INT(5) THEN
702 FAILED ("INCORRECT VALUE OF XRP1 (5)");
705 IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE))
707 FAILED ("INCORRECT VALUE OF XRV1 (5)");
711 IF I /= IDENT_INT(5) THEN
712 FAILED ("INCORRECT RETURN VALUE OF " &
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)");
723 FOR J IN XAA1'RANGE LOOP
724 IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),
726 FAILED ("INCORRECT VALUE OF XAA1(" &
727 INTEGER'IMAGE(J) & ") (5)");
731 FOR J IN XAR1'RANGE LOOP
732 IF XAR1(J) /= (D => 1, FIELD1 =>
734 FAILED ("INCORRECT VALUE OF XAR1(" &
735 INTEGER'IMAGE(J) & ") (5)");
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)");
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)");
755 FOR J IN XAT1'RANGE LOOP
757 IF I /= IDENT_INT(5) THEN
758 FAILED ("INCORRECT RETURN VALUE " &
760 INTEGER'IMAGE(J) & ").VALU (5)");
768 MAIN_TASK.START (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
773 FOR I IN DAT1'RANGE LOOP