1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
-- CC70C02.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that a generic formal package is an instance. Specifically,
-- check that a generic formal package may be passed as an actual
-- parameter to another generic formal package. Check that the
-- visible part of the generic formal package includes the first list of
-- basic declarative items of the package specification.
--
-- TEST DESCRIPTION:
-- A generic formal package is a package, and is an instance.
--
-- Declare a list type in a generic package for lists of elements of any
-- nonlimited type (foundation code). Declare a second generic package
-- which declares operations for the list type, and parameterize it with
-- a generic formal package with the list-type package as template
-- (foundation code). Declare a third generic package which declares
-- additional operations for the list type, and parameterize it with two
-- generic formal packages, one with the list-type package as template,
-- the other with the second generic package as template. Use the first
-- formal package as the generic formal actual part for the second formal
-- package.
--
-- TEST FILES:
-- The following files comprise this test:
--
-- FC70C00.A
-- CC70C02.A
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
with FC70C00_0; -- List abstraction.
with FC70C00_1; -- Basic list operations.
generic
-- Import both the list-type abstraction defined in FC70C00_0 and the basic
-- list operations defined in FC70C00_1. To ensure that only basic operation
-- instances for lists of the same element type as that used to instantiate
-- the list type are accepted as actuals to this generic, pass the list-type
-- formal package as an actual parameter to the list-operation formal
-- package.
with package Lists is new FC70C00_0 (<>);
with package Basic_List_Ops is new FC70C00_1 (Lists);
package CC70C02_0 is -- Additional list operations.
End_of_List_Reached : exception;
-- Read from current element and advance "current" pointer.
procedure Read_Element (L : in out Lists.List_Type;
E : out Lists.Element_Type);
-- Add element to end of list.
procedure Add_Element (L : in out Lists.List_Type;
E : in Lists.Element_Type);
end CC70C02_0;
--==================================================================--
package body CC70C02_0 is
procedure Read_Element (L : in out Lists.List_Type;
E : out Lists.Element_Type) is
begin
if Basic_List_Ops.End_Of_List (L) then -- Use of op from the previous
raise End_Of_List_Reached; -- generic package.
else
E := L.Current.Item; -- Retrieve current element.
L.Current := L.Current.Next; -- Advance "current" pointer.
end if;
end Read_Element;
procedure Add_Element (L : in out Lists.List_Type;
E : in Lists.Element_Type) is
New_Node : Lists.Node_Pointer := new Lists.Node_Type'(E, null);
use type Lists.Node_Pointer;
begin
if L.First = null then -- No elements in list, so add new
L.First := New_Node; -- element at beginning of list.
else
L.Last.Next := New_Node; -- Add new element at end of list.
end if;
L.Last := New_Node; -- Set last-in-list pointer.
end Add_Element;
end CC70C02_0;
--==================================================================--
with FC70C00_0; -- Generic list type abstraction.
with FC70C00_1; -- Generic list operations.
with CC70C02_0; -- Additional generic list operations.
with Report;
procedure CC70C02 is
type Points is range 0 .. 100; -- Discrete type.
package Lists_of_Points is new FC70C00_0 (Points); -- Points lists.
package Basic_Point_Ops is new -- Basic points-list ops.
FC70C00_1 (Lists_Of_Points);
package Points_List_Ops is new -- More points-list ops.
CC70C02_0 (Lists => Lists_Of_Points,
Basic_List_Ops => Basic_Point_Ops);
Scores : Lists_of_Points.List_Type; -- List of points.
-- Begin test code declarations: -----------------------
type TC_Score_Array is array (1 .. 3) of Points;
TC_List_Values : constant TC_Score_Array := (23, 15, 0);
TC_Correct_List_Values : Boolean := False;
procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
begin -- Initial list contains 3 scores
for I in TC_Score_Array'Range loop -- with the values 23, 15, and 0.
Points_List_Ops.Add_Element (L, TC_List_Values(I));
end loop;
end TC_Initialize_List;
procedure TC_Verify_List (L : in out Lists_Of_Points.List_Type;
Expected : in TC_Score_Array;
OK : out Boolean) is
Actual : TC_Score_Array;
begin
Basic_Point_Ops.Reset (L);
for I in TC_Score_Array'Range loop
Points_List_Ops.Read_Element (L, Actual(I));
end loop;
OK := (Actual = Expected);
end TC_Verify_List;
-- End test code declarations. -------------------------
begin
Report.Test ("CC70C02", "Check that a generic formal package may be " &
"passed as an actual to another formal package");
TC_Initialize_List (Scores);
TC_Verify_List (Scores, TC_List_Values, TC_Correct_List_Values);
if not TC_Correct_List_Values then
Report.Failed ("List contains incorrect values");
end if;
Report.Result;
end CC70C02;
|
