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
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
-- CC70002.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 formal package actual part may specify actual parameters
-- for a generic formal package. Check that these actual parameters may
-- be formal types, formal objects, and formal subprograms. Check that
-- the visible part of the generic formal package includes the first list
-- of basic declarative items of the package specification, and that if
-- the formal package actual part is (<>), it also includes the generic
-- formal part of the template for the formal package.
--
-- TEST DESCRIPTION:
-- Declare a generic package which defines a "signature" for mathematical
-- groups. Declare a second generic package which defines a
-- two-dimensional matrix abstraction. Declare a third generic package
-- which provides mathematical group operations for two-dimensional
-- matrices. Provide this third generic with two formal parameters: (1)
-- a generic formal package with the second generic as template and a
-- (<>) actual part, and (2) a generic formal package with the first
-- generic as template and an actual part that takes a formal type,
-- object, and subprogram from the first formal package as actuals.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
generic -- Mathematical group signature.
type Group_Type is private;
Identity : in Group_Type;
with function Operation (Left, Right : Group_Type) return Group_Type;
-- with function Inverse... (omitted for brevity).
package CC70002_0 is
function Power (Left : Group_Type; Right : Integer) return Group_Type;
-- ... Other group operations.
end CC70002_0;
--==================================================================--
package body CC70002_0 is
-- The implementation of Power is purely artificial; the validity of its
-- implementation in the context of the abstraction is irrelevant to the
-- feature being tested.
function Power (Left : Group_Type; Right : Integer) return Group_Type is
Result : Group_Type := Identity;
begin
Result := Operation (Result, Left); -- All this really does is add
return Result; -- one to each matrix element.
end Power;
end CC70002_0;
--==================================================================--
generic -- 2D matrix abstraction.
type Element_Type is range <>;
type Abscissa is range <>;
type Ordinate is range <>;
type Matrix_2D is array (Abscissa, Ordinate) of Element_Type;
package CC70002_1 is
Add_Ident : constant Matrix_2D := (Abscissa => (others => 1));
-- Artificial for
-- testing purposes.
-- ... Other identity matrices.
function "+" (A, B : Matrix_2D) return Matrix_2D;
-- ... Other operations.
end CC70002_1;
--==================================================================--
package body CC70002_1 is
function "+" (A, B : Matrix_2D) return Matrix_2D is
C : Matrix_2D;
begin
for I in Abscissa loop
for J in Ordinate loop
C(I,J) := A(I,J) + B(I,J);
end loop;
end loop;
return C;
end "+";
end CC70002_1;
--==================================================================--
with CC70002_0; -- Mathematical group signature.
with CC70002_1; -- 2D matrix abstraction.
generic -- Mathematical 2D matrix addition group.
with package Matrix_Ops is new CC70002_1 (<>);
-- Although the restriction of the formal package below to signatures
-- describing addition groups, and then only for 2D matrices, is rather
-- artificial in the context of this "application," the passing of types,
-- objects, and subprograms as actuals to a formal package is not.
with package Math_Sig is new CC70002_0
(Group_Type => Matrix_Ops.Matrix_2D,
Identity => Matrix_Ops.Add_Ident,
Operation => Matrix_Ops."+");
package CC70002_2 is
-- Add two matrices that are to be multiplied by coefficients:
-- [ ] = CA*[ ] + CB*[ ].
function Add_Matrices_With_Coefficients (A : Matrix_Ops.Matrix_2D;
CA : Integer;
B : Matrix_Ops.Matrix_2D;
CB : Integer)
return Matrix_Ops.Matrix_2D;
-- ...Other operations.
end CC70002_2;
--==================================================================--
package body CC70002_2 is
function Add_Matrices_With_Coefficients (A : Matrix_Ops.Matrix_2D;
CA : Integer;
B : Matrix_Ops.Matrix_2D;
CB : Integer)
return Matrix_Ops.Matrix_2D is
Left, Right : Matrix_Ops.Matrix_2D;
begin
Left := Math_Sig.Power (A, CA); -- Multiply 1st array by its coeff.
Right := Math_Sig.Power (B, CB); -- Multiply 2nd array by its coeff.
return (Matrix_Ops."+" (Left, Right));-- Add these two arrays.
end Add_Matrices_With_Coefficients;
end CC70002_2;
--==================================================================--
with CC70002_0; -- Mathematical group signature.
with CC70002_1; -- 2D matrix abstraction.
with CC70002_2; -- Mathematical 2D matrix addition group.
with Report;
procedure CC70002 is
subtype Cell_Type is Positive range 1 .. 3;
subtype Category_Type is Positive range 1 .. 2;
type Data_Points is new Natural range 0 .. 100;
type Table_Type is array (Cell_Type, Category_Type) of Data_Points;
package Data_Table_Support is new CC70002_1 (Data_Points,
Cell_Type,
Category_Type,
Table_Type);
package Data_Table_Addition_Group is new CC70002_0
(Group_Type => Table_Type,
Identity => Data_Table_Support.Add_Ident,
Operation => Data_Table_Support."+");
package Table_Add_Ops is new CC70002_2
(Data_Table_Support, Data_Table_Addition_Group);
Scores_Table : Table_Type := ( ( 12, 0),
( 21, 33),
( 49, 9) );
Expected : Table_Type := ( ( 26, 2),
( 44, 68),
( 100, 20) );
begin
Report.Test ("CC70002", "Check that a generic formal package actual " &
"part may specify formal objects, formal subprograms, " &
"and formal types");
Scores_Table := Table_Add_Ops.Add_Matrices_With_Coefficients
(Scores_Table, 2,
Scores_Table, 1);
if (Scores_Table /= Expected) then
Report.Failed ("Incorrect result for multi-dimensional array");
end if;
Report.Result;
end CC70002;
|
