1-- CC3019B0.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--  THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
26--  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION.
27--
28-- HISTORY:
29--         EDWARD V. BERARD, 31 AUGUST 1990
30
31GENERIC
32
33     TYPE ELEMENT IS LIMITED PRIVATE ;
34
35     WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
36                            DESTINATION   : IN OUT ELEMENT) ;
37
38     WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
39                        RIGHT : IN ELEMENT) RETURN BOOLEAN ;
40
41PACKAGE CC3019B0_LIST_CLASS IS
42
43     TYPE LIST IS LIMITED PRIVATE ;
44
45     OVERFLOW    : EXCEPTION ;
46     UNDERFLOW    : EXCEPTION ;
47
48     PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
49                       TO_THIS_LIST        : IN OUT LIST) ;
50
51     PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
52                       FROM_THIS_LIST    : IN OUT LIST) ;
53
54     PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
55                       TO_THIS_LIST        : IN OUT LIST) ;
56
57     PROCEDURE CLEAR  (THIS_LIST           : IN OUT LIST) ;
58
59     GENERIC
60
61          WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
62                                  CONTINUE        : OUT BOOLEAN) ;
63
64     PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) ;
65
66     FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
67          RETURN NATURAL ;
68
69     FUNCTION "=" (LEFT  : IN LIST ;
70                   RIGHT : IN LIST) RETURN BOOLEAN ;
71
72PRIVATE
73
74     TYPE LIST_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF ELEMENT ;
75
76     TYPE LIST IS RECORD
77          LENGTH        : NATURAL := 0 ;
78          ACTUAL_LIST   : LIST_TABLE ;
79     END RECORD ;
80
81END CC3019B0_LIST_CLASS ;
82
83PACKAGE BODY CC3019B0_LIST_CLASS IS
84
85     PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
86                       TO_THIS_LIST        : IN OUT LIST) IS
87
88     BEGIN  -- ADD
89
90          IF TO_THIS_LIST.LENGTH >= 10 THEN
91               RAISE OVERFLOW ;
92          ELSE
93               TO_THIS_LIST.LENGTH := TO_THIS_LIST.LENGTH + 1 ;
94               ASSIGN (
95                    SOURCE      => THIS_ELEMENT,
96                    DESTINATION =>
97                        TO_THIS_LIST.ACTUAL_LIST (TO_THIS_LIST.LENGTH));
98          END IF ;
99
100     END ADD ;
101
102     PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
103                       FROM_THIS_LIST    : IN OUT LIST) IS
104
105     BEGIN  -- DELETE
106
107          IF FROM_THIS_LIST.LENGTH <= 0 THEN
108               RAISE UNDERFLOW ;
109          ELSE
110               ASSIGN (
111                    SOURCE      =>
112                      FROM_THIS_LIST.ACTUAL_LIST(FROM_THIS_LIST.LENGTH),
113                    DESTINATION => THIS_ELEMENT) ;
114               FROM_THIS_LIST.LENGTH := FROM_THIS_LIST.LENGTH - 1 ;
115          END IF ;
116
117     END DELETE ;
118
119     PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
120                           TO_THIS_LIST        : IN OUT LIST) IS
121
122     BEGIN  -- COPY
123
124          TO_THIS_LIST.LENGTH := THIS_LIST.LENGTH ;
125          FOR INDEX IN TO_THIS_LIST.ACTUAL_LIST'RANGE LOOP
126               ASSIGN (
127                    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 CC3019B0_LIST_CLASS ;
192