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.
27 -- Check that the template for a generic formal package may be a child
28 -- package, and that a child instance which is an instance of the
29 -- template may be passed as an actual to the formal package. Check that
30 -- the visible part of the generic formal package includes the first list
31 -- of basic declarative items of the package specification.
34 -- Declare a list abstraction in a generic package which manages lists of
35 -- elements of any nonlimited type. Declare a generic child package of
36 -- this package which defines additional list operations. Declare a
37 -- generic subprogram which operates on lists of elements of discrete
38 -- types. Provide the generic subprogram with three formal parameters:
39 -- (1) a formal discrete type which represents a list element type, (2)
40 -- a generic formal package with the parent list generic as template, and
41 -- (3) a generic formal package with the child list generic as template.
42 -- Use the formal discrete type as the generic formal actual part for the
43 -- parent formal package. In the main program, declare an instance of
44 -- parent, then declare an instance of the child which is itself a child
45 -- the parent's instance. Pass these instances as actuals to the generic
46 -- subprogram instance.
50 -- 06 Dec 94 SAIC ACVC 2.0
51 -- 05 Nov 95 SAIC ACVC 2.0.1 fixes: Corrected syntax of formal
52 -- package declaration.
53 -- 27 Feb 97 PWB.CTA Added an elaboration pragma.
57 type Element_Type
is private; -- List elems may be of any nonlimited type.
58 package CC70001_0
is -- List abstraction.
60 type List_Type
is limited private;
63 -- Return true if current element is last in the list.
64 function End_Of_List
(L
: List_Type
) return Boolean;
66 -- Set "current" pointer to first list element.
67 procedure Reset
(L
: in out List_Type
);
72 type Node_Pointer
is access Node_Type
;
74 type Node_Type
is record
79 type List_Type
is record
81 Current
: Node_Pointer
;
88 --==================================================================--
91 package body CC70001_0
is
93 function End_Of_List
(L
: List_Type
) return Boolean is
95 return (L
.Current
= null);
99 procedure Reset
(L
: in out List_Type
) is
101 L
.Current
:= L
.First
; -- Set "current" pointer to first
102 end Reset
; -- list element.
107 --==================================================================--
110 -- Child must be generic since parent is generic. A formal parameter for
111 -- "element type" can not be provided here, because then the type of list
112 -- element assumed by these new operations would be different from that
113 -- defined by the list type declared in the parent.
116 package CC70001_0
.CC70001_1
is -- Additional list operations.
118 -- Read from current element and advance "current" pointer.
119 procedure Read_Element
(L
: in out List_Type
; E
: out Element_Type
);
121 -- Write to current element and advance "current" pointer.
122 procedure Write_Element
(L
: in out List_Type
; E
: in Element_Type
);
124 -- Add element to end of list.
125 procedure Add_Element
(L
: in out List_Type
; E
: in Element_Type
);
127 end CC70001_0
.CC70001_1
;
130 --==================================================================--
133 package body CC70001_0
.CC70001_1
is
135 procedure Read_Element
(L
: in out List_Type
; E
: out Element_Type
) is
137 -- ... Error-checking code omitted for brevity.
138 E
:= L
.Current
.Item
; -- Retrieve current element.
139 L
.Current
:= L
.Current
.Next
; -- Advance "current" pointer.
143 procedure Write_Element
(L
: in out List_Type
; E
: in Element_Type
) is
145 -- ... Error-checking code omitted for brevity.
146 L
.Current
.Item
:= E
; -- Write to current element.
147 L
.Current
:= L
.Current
.Next
; -- Advance "current" pointer.
151 procedure Add_Element
(L
: in out List_Type
; E
: in Element_Type
) is
152 New_Node
: Node_Pointer
:= new Node_Type
'(E, null);
154 if L.First = null then -- No elements in list, so add new
155 L.First := New_Node; -- element at beginning of list.
157 L.Last.Next := New_Node; -- Add new element at end of list.
159 L.Last := New_Node; -- Set last-in-list pointer.
162 end CC70001_0.CC70001_1;
165 --==================================================================--
168 with CC70001_0.CC70001_1; -- Generic list abstraction + additional operations.
171 -- Import the list abstraction defined in CC70001_0, as well as the
172 -- additional operations defined in CC70001_0.CC70001_1. Declare a formal
173 -- discrete type. Restrict this generic procedure to operate only on lists
174 -- of discrete elements by passing the formal discrete type as an actual
175 -- parameter to the formal (parent) package.
177 type Elem_Type is (<>); -- Discrete types only.
178 with package List_Mgr is new CC70001_0 (Elem_Type);
179 with package List_Ops is new List_Mgr.CC70001_1 (<>);
181 procedure CC70001_2 (L : in out List_Mgr.List_Type);
184 --==================================================================--
187 procedure CC70001_2 (L : in out List_Mgr.List_Type) is
190 while not List_Mgr.End_Of_List (L) loop
191 List_Ops.Write_Element (L, Elem_Type'First);
196 --==================================================================--
201 type Points is range 0 .. 10;
203 -- ... Various other types used by the application.
208 -- No body for CC70001_3;
211 --==================================================================--
214 -- Declare instances of the generic list packages for the discrete type.
215 -- In order to establish that the type passed as an actual to the parent
216 -- generic (CC70001_0) is the one utilized by the child generic (CC70001_1),
217 -- the instance of the child must itself be declared as a child of the
218 -- instance of the parent. Since only library units may have or be children,
219 -- both instances must be library units.
221 with CC70001_0; -- Generic list abstraction.
222 with CC70001_3; -- Package containing discrete type declaration.
223 pragma Elaborate (CC70001_0);
224 package CC70001_4 is new CC70001_0 (CC70001_3.Points);
226 with CC70001_0.CC70001_1; -- Generic extension to list abstraction.
228 package CC70001_4.CC70001_5 is new CC70001_4.CC70001_1;
231 --==================================================================--
234 with CC70001_2; -- Generic "zeroing" op for lists of discrete types.
235 with CC70001_3; -- Types for application.
236 with CC70001_4.CC70001_5; -- Discrete list abstraction + additional ops.
241 package Lists_Of_Scores renames CC70001_4;
242 package Score_Ops renames CC70001_4.CC70001_5;
244 Scores : Lists_Of_Scores.List_Type; -- List of points.
246 procedure Reset_All_Scores is new CC70001_2 -- Operation on lists of
247 (Elem_Type => CC70001_3.Points, -- points.
248 List_Mgr => Lists_Of_Scores,
249 List_Ops => Score_Ops);
252 -- Begin test code declarations: -----------------------
254 type TC_Score_Array is array (1 .. 3) of CC70001_3.Points;
256 TC_Initial_Values : constant TC_Score_Array := (2, 4, 6);
257 TC_Final_Values : constant TC_Score_Array := (0, 0, 0);
259 TC_Correct_Initial_Values : Boolean := False;
260 TC_Correct_Final_Values : Boolean := False;
263 procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
264 begin -- Initial list contains 3 scores
265 for I in TC_Score_Array'Range loop -- with the values 2, 4, and 6.
266 Score_Ops.Add_Element (L, TC_Initial_Values(I));
268 end TC_Initialize_List;
271 procedure TC_Verify_List (L : in out Lists_of_Scores.List_Type;
272 Expected : in TC_Score_Array;
274 Actual : TC_Score_Array;
275 begin -- Verify that all scores have been
276 Lists_of_Scores.Reset (L); -- set to zero.
277 for I in TC_Score_Array'Range loop
278 Score_Ops.Read_Element (L, Actual(I));
280 OK := (Actual = Expected);
283 -- End test code declarations. -------------------------
287 Report.Test ("CC70001", "Check that the template for a generic formal " &
288 "package may be a child package, and that a child instance " &
289 "which is an instance of the template may be passed as an " &
290 "actual to the formal package. Check that the visible part " &
291 "of the generic formal package includes the first list of " &
292 "basic declarative items of the package specification");
294 TC_Initialize_List (Scores);
295 TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
297 if not TC_Correct_Initial_Values then
298 Report.Failed ("List contains incorrect initial values");
301 Reset_All_Scores (Scores);
302 TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
304 if not TC_Correct_Final_Values then
305 Report.Failed ("List contains incorrect final values");