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.
25 -- CHECK THAT INSTANTIATIONS OF NESTED GENERIC UNITS ARE PROCESSED
31 TYPE ELEMENT_TYPE
IS PRIVATE;
32 PACKAGE CC3019A_QUEUES
IS
34 TYPE QUEUE_TYPE
IS PRIVATE;
36 PROCEDURE ADD
(TO_Q
: IN OUT QUEUE_TYPE
;
37 VALUE
: ELEMENT_TYPE
);
40 WITH PROCEDURE APPLY
(VAL
: ELEMENT_TYPE
);
41 PROCEDURE ITERATOR
(TO_Q
: QUEUE_TYPE
);
45 TYPE CONTENTS_TYPE
IS ARRAY (1..3) OF ELEMENT_TYPE
;
48 CONTENTS
: CONTENTS_TYPE
;
54 PACKAGE BODY CC3019A_QUEUES
IS
56 PROCEDURE ADD
(TO_Q
: IN OUT QUEUE_TYPE
;
57 VALUE
: ELEMENT_TYPE
) IS
59 TO_Q
.SIZE
:= TO_Q
.SIZE
+ 1;
60 TO_Q
.CONTENTS
(TO_Q
.SIZE
) := VALUE
;
64 -- WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
65 PROCEDURE ITERATOR
(TO_Q
: QUEUE_TYPE
) IS
67 FOR I
IN TO_Q
.CONTENTS
'FIRST .. TO_Q
.SIZE
LOOP
68 APPLY
(TO_Q
.CONTENTS
(I
));
74 WITH REPORT
; USE REPORT
;
78 SUBTYPE STR6
IS STRING (1..6);
80 TYPE STR6_ARR
IS ARRAY (1..3) OF STR6
;
81 STR6_VALS
: STR6_ARR
:= ("111111", "222222",
83 CUR_STR_INDEX
: NATURAL := 1;
85 TYPE INT_ARR
IS ARRAY (1..3) OF INTEGER;
86 INT_VALS
: INT_ARR
:= (-1, 3, IDENT_INT
(3));
87 CUR_INT_INDEX
: NATURAL := 1;
89 -- THIS PROCEDURE IS CALLED ONCE FOR EACH ELEMENT OF THE QUEUE
91 PROCEDURE CHECK_STR
(VAL
: STR6
) IS
93 IF VAL
/= STR6_VALS
(CUR_STR_INDEX
) THEN
94 FAILED
("STR6 ITERATOR FOR INDEX =" &
95 INTEGER'IMAGE(CUR_STR_INDEX
) & " WITH VALUE " &
98 CUR_STR_INDEX
:= CUR_STR_INDEX
+ 1;
100 WHEN CONSTRAINT_ERROR
=>
101 FAILED
("STR6 - CONSTRAINT_ERROR RAISED");
103 FAILED
("STR6 - UNEXPECTED EXCEPTION");
106 PROCEDURE CHECK_INT
(VAL
: INTEGER) IS
108 IF VAL
/= INT_VALS
(CUR_INT_INDEX
) THEN
109 FAILED
("INTEGER ITERATOR FOR INDEX =" &
110 INTEGER'IMAGE(CUR_INT_INDEX
) & " WITH VALUE " &
111 """" & INTEGER'IMAGE(VAL
) & """");
113 CUR_INT_INDEX
:= CUR_INT_INDEX
+ 1;
115 WHEN CONSTRAINT_ERROR
=>
116 FAILED
("INTEGER - CONSTRAINT_ERROR RAISED");
118 FAILED
("INTEGER - UNEXPECTED EXCEPTION");
121 PACKAGE STR6_QUEUE
IS NEW CC3019A_QUEUES
(STR6
);
124 PACKAGE INT_QUEUE
IS NEW CC3019A_QUEUES
(INTEGER);
129 TEST
("CC3019A", "CHECK NESTED GENERICS - ITERATORS");
132 Q1
: STR6_QUEUE
.QUEUE_TYPE
;
134 PROCEDURE CHK_STR
IS NEW STR6_QUEUE
.ITERATOR
(CHECK_STR
);
147 FAILED
("UNEXPECTED EXCEPTION - Q1");
150 -- REPEAT FOR INTEGERS
153 Q2
: INT_QUEUE
.QUEUE_TYPE
;
155 PROCEDURE CHK_INT
IS NEW INT_QUEUE
.ITERATOR
(CHECK_INT
);
168 FAILED
("UNEXPECTED EXCEPTION - Q2");