1-- CC3019C0.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--   THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
27--   NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION.
28--
29-- HISTORY:
30--         EDWARD V. BERARD, 31 AUGUST 1990
31
32GENERIC
33
34     TYPE ELEMENT IS LIMITED PRIVATE ;
35
36     WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
37                            DESTINATION   : IN OUT ELEMENT) ;
38
39     WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
40                        RIGHT : IN ELEMENT) RETURN BOOLEAN ;
41
42PACKAGE CC3019C0_LIST_CLASS IS
43
44     TYPE LIST IS LIMITED PRIVATE ;
45
46     OVERFLOW    : EXCEPTION ;
47     UNDERFLOW   : EXCEPTION ;
48
49     PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
50                       TO_THIS_LIST        : IN OUT LIST) ;
51
52     PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
53                       FROM_THIS_LIST    : IN OUT LIST) ;
54
55     PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
56                       TO_THIS_LIST        : IN OUT LIST) ;
57
58     PROCEDURE CLEAR  (THIS_LIST           : IN OUT LIST) ;
59
60     GENERIC
61
62          WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
63                                  CONTINUE        : OUT BOOLEAN) ;
64
65     PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) ;
66
67     FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
68          RETURN NATURAL ;
69
70     FUNCTION "=" (LEFT  : IN LIST ;
71                   RIGHT : IN LIST) RETURN BOOLEAN ;
72
73PRIVATE
74
75     TYPE LIST_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF ELEMENT ;
76
77     TYPE LIST IS RECORD
78          LENGTH        : NATURAL := 0 ;
79          ACTUAL_LIST   : LIST_TABLE ;
80     END RECORD ;
81
82END CC3019C0_LIST_CLASS ;
83
84PACKAGE BODY CC3019C0_LIST_CLASS IS
85
86     PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
87                       TO_THIS_LIST        : IN OUT LIST) IS
88
89     BEGIN  -- ADD
90
91          IF TO_THIS_LIST.LENGTH >= 10 THEN
92               RAISE OVERFLOW ;
93          ELSE
94               TO_THIS_LIST.LENGTH := TO_THIS_LIST.LENGTH + 1 ;
95               ASSIGN (
96                    SOURCE      => THIS_ELEMENT,
97                    DESTINATION =>
98                         TO_THIS_LIST.ACTUAL_LIST(TO_THIS_LIST.LENGTH));
99          END IF ;
100
101     END ADD ;
102
103     PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
104                       FROM_THIS_LIST    : IN OUT LIST) IS
105
106     BEGIN  -- DELETE
107
108          IF FROM_THIS_LIST.LENGTH <= 0 THEN
109               RAISE UNDERFLOW ;
110          ELSE
111               ASSIGN (
112                    SOURCE      =>
113                      FROM_THIS_LIST.ACTUAL_LIST(FROM_THIS_LIST.LENGTH),
114                    DESTINATION => THIS_ELEMENT) ;
115               FROM_THIS_LIST.LENGTH := FROM_THIS_LIST.LENGTH - 1 ;
116          END IF ;
117
118     END DELETE ;
119
120     PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
121                       TO_THIS_LIST        : IN OUT LIST) IS
122
123     BEGIN  -- COPY
124
125          TO_THIS_LIST.LENGTH := THIS_LIST.LENGTH ;
126          FOR INDEX IN TO_THIS_LIST.ACTUAL_LIST'RANGE LOOP
127               ASSIGN (SOURCE      => THIS_LIST.ACTUAL_LIST (INDEX),
128                       DESTINATION => TO_THIS_LIST.ACTUAL_LIST (INDEX));
129          END LOOP ;
130
131     END COPY ;
132
133     PROCEDURE CLEAR  (THIS_LIST         : IN OUT LIST) IS
134
135     BEGIN  -- CLEAR
136
137          THIS_LIST.LENGTH := 0 ;
138
139     END CLEAR ;
140
141     PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) IS
142
143          CONTINUE : BOOLEAN := TRUE ;
144          FINISHED : NATURAL := 0 ;
145
146     BEGIN  -- ITERATE
147
148          WHILE (CONTINUE = TRUE) AND (FINISHED < OVER_THIS_LIST.LENGTH)
149               LOOP
150                    FINISHED := FINISHED + 1 ;
151                    PROCESS (THIS_ELEMENT =>
152                                OVER_THIS_LIST.ACTUAL_LIST (FINISHED),
153                             CONTINUE     => CONTINUE) ;
154               END LOOP ;
155
156     END ITERATE ;
157
158     FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
159          RETURN NATURAL IS
160
161     BEGIN  -- NUMBER_OF_ELEMENTS
162
163          RETURN IN_THIS_LIST.LENGTH ;
164
165     END NUMBER_OF_ELEMENTS ;
166
167     FUNCTION "=" (LEFT  : IN LIST ;
168                   RIGHT : IN LIST) RETURN BOOLEAN IS
169
170          RESULT : BOOLEAN := TRUE ;
171          INDEX  : NATURAL := 0 ;
172
173     BEGIN  -- "="
174
175          IF LEFT.LENGTH /= RIGHT.LENGTH THEN
176               RESULT := FALSE ;
177          ELSE
178               WHILE (INDEX < LEFT.LENGTH) AND RESULT LOOP
179                    INDEX := INDEX + 1 ;
180                    IF LEFT.ACTUAL_LIST (INDEX) /=
181                       RIGHT.ACTUAL_LIST (INDEX) THEN
182                        RESULT := FALSE ;
183                    END IF ;
184               END LOOP ;
185          END IF ;
186
187          RETURN RESULT ;
188
189     END "=" ;
190
191END CC3019C0_LIST_CLASS ;
192