OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc70002.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CC70002.A
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
--
26
-- OBJECTIVE:
27
--      Check that a formal package actual part may specify actual parameters
28
--      for a generic formal package. Check that these actual parameters may
29
--      be formal types, formal objects, and formal subprograms. Check that
30
--      the visible part of the generic formal package includes the first list
31
--      of basic declarative items of the package specification, and that if
32
--      the formal package actual part is (<>), it also includes the generic
33
--      formal part of the template for the formal package.
34
--
35
-- TEST DESCRIPTION:
36
--      Declare a generic package which defines a "signature" for mathematical
37
--      groups. Declare a second generic package which defines a
38
--      two-dimensional matrix abstraction. Declare a third generic package
39
--      which provides mathematical group operations for two-dimensional
40
--      matrices. Provide this third generic with two formal parameters: (1)
41
--      a generic formal package with the second generic as template and a
42
--      (<>) actual part, and (2) a generic formal package with the first
43
--      generic as template and an actual part that takes a formal type,
44
--      object, and subprogram from the first formal package as actuals.
45
--
46
--
47
-- CHANGE HISTORY:
48
--      06 Dec 94   SAIC    ACVC 2.0
49
--
50
--!
51
 
52
generic              -- Mathematical group signature.
53
 
54
   type Group_Type is private;
55
 
56
   Identity : in Group_Type;
57
 
58
   with function Operation (Left, Right : Group_Type) return Group_Type;
59
-- with function Inverse... (omitted for brevity).
60
 
61
package CC70002_0 is
62
 
63
   function Power (Left : Group_Type; Right : Integer) return Group_Type;
64
 
65
   -- ... Other group operations.
66
 
67
end CC70002_0;
68
 
69
 
70
     --==================================================================--
71
 
72
 
73
package body CC70002_0 is
74
 
75
   -- The implementation of Power is purely artificial; the validity of its
76
   -- implementation in the context of the abstraction is irrelevant to the
77
   -- feature being tested.
78
 
79
   function Power (Left : Group_Type; Right : Integer) return Group_Type is
80
      Result : Group_Type := Identity;
81
   begin
82
      Result := Operation (Result, Left);  -- All this really does is add
83
      return Result;                       -- one to each matrix element.
84
   end Power;
85
 
86
end CC70002_0;
87
 
88
 
89
     --==================================================================--
90
 
91
 
92
generic          -- 2D matrix abstraction.
93
   type Element_Type is range <>;
94
 
95
   type Abscissa is range <>;
96
   type Ordinate is range <>;
97
 
98
   type Matrix_2D is array (Abscissa, Ordinate) of Element_Type;
99
package CC70002_1 is
100
 
101
   Add_Ident : constant Matrix_2D := (Abscissa => (others => 1));
102
                                                          -- Artificial for
103
                                                          -- testing purposes.
104
   -- ... Other identity matrices.
105
 
106
 
107
   function "+" (A, B : Matrix_2D) return Matrix_2D;
108
 
109
   -- ... Other operations.
110
 
111
end CC70002_1;
112
 
113
 
114
     --==================================================================--
115
 
116
 
117
package body CC70002_1 is
118
 
119
   function "+" (A, B : Matrix_2D) return Matrix_2D is
120
      C : Matrix_2D;
121
   begin
122
      for I in Abscissa loop
123
         for J in Ordinate loop
124
            C(I,J) := A(I,J) + B(I,J);
125
         end loop;
126
      end loop;
127
      return C;
128
   end "+";
129
 
130
end CC70002_1;
131
 
132
 
133
     --==================================================================--
134
 
135
 
136
with CC70002_0;  -- Mathematical group signature.
137
with CC70002_1;  -- 2D matrix abstraction.
138
 
139
generic          -- Mathematical 2D matrix addition group.
140
 
141
   with package Matrix_Ops is new CC70002_1 (<>);
142
 
143
   -- Although the restriction of the formal package below to signatures
144
   -- describing addition groups, and then only for 2D matrices, is rather
145
   -- artificial in the context of this "application," the passing of types,
146
   -- objects, and subprograms as actuals to a formal package is not.
147
 
148
   with package Math_Sig is new CC70002_0
149
     (Group_Type => Matrix_Ops.Matrix_2D,
150
      Identity   => Matrix_Ops.Add_Ident,
151
      Operation  => Matrix_Ops."+");
152
 
153
package CC70002_2 is
154
 
155
   -- Add two matrices that are to be multiplied by coefficients:
156
   -- [ ] = CA*[ ] + CB*[ ].
157
 
158
   function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;
159
                                            CA : Integer;
160
                                            B  : Matrix_Ops.Matrix_2D;
161
                                            CB : Integer)
162
     return Matrix_Ops.Matrix_2D;
163
 
164
   -- ...Other operations.
165
 
166
end CC70002_2;
167
 
168
 
169
     --==================================================================--
170
 
171
 
172
package body CC70002_2 is
173
 
174
   function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;
175
                                            CA : Integer;
176
                                            B  : Matrix_Ops.Matrix_2D;
177
                                            CB : Integer)
178
     return Matrix_Ops.Matrix_2D is
179
      Left, Right : Matrix_Ops.Matrix_2D;
180
   begin
181
      Left  := Math_Sig.Power (A, CA);      -- Multiply 1st array by its coeff.
182
      Right := Math_Sig.Power (B, CB);      -- Multiply 2nd array by its coeff.
183
      return (Matrix_Ops."+" (Left, Right));-- Add these two arrays.
184
   end Add_Matrices_With_Coefficients;
185
 
186
end CC70002_2;
187
 
188
 
189
     --==================================================================--
190
 
191
 
192
with CC70002_0;  -- Mathematical group signature.
193
with CC70002_1;  -- 2D matrix abstraction.
194
with CC70002_2;  -- Mathematical 2D matrix addition group.
195
 
196
with Report;
197
procedure CC70002 is
198
 
199
   subtype Cell_Type     is Positive range 1 .. 3;
200
   subtype Category_Type is Positive range 1 .. 2;
201
 
202
   type Data_Points is new Natural range 0 .. 100;
203
 
204
   type Table_Type is array (Cell_Type, Category_Type) of Data_Points;
205
 
206
   package Data_Table_Support is new CC70002_1 (Data_Points,
207
                                                Cell_Type,
208
                                                Category_Type,
209
                                                Table_Type);
210
 
211
   package Data_Table_Addition_Group is new CC70002_0
212
     (Group_Type => Table_Type,
213
      Identity   => Data_Table_Support.Add_Ident,
214
      Operation  => Data_Table_Support."+");
215
 
216
   package Table_Add_Ops is new CC70002_2
217
     (Data_Table_Support, Data_Table_Addition_Group);
218
 
219
 
220
   Scores_Table : Table_Type := ( (  12,   0),
221
                                  (  21,  33),
222
                                  (  49,   9) );
223
   Expected     : Table_Type := ( (  26,   2),
224
                                  (  44,  68),
225
                                  ( 100,  20) );
226
 
227
begin
228
   Report.Test ("CC70002", "Check that a generic formal package actual " &
229
                "part may specify formal objects, formal subprograms, " &
230
                "and formal types");
231
 
232
   Scores_Table := Table_Add_Ops.Add_Matrices_With_Coefficients
233
                     (Scores_Table, 2,
234
                      Scores_Table, 1);
235
 
236
   if (Scores_Table /= Expected) then
237
      Report.Failed ("Incorrect result for multi-dimensional array");
238
   end if;
239
 
240
   Report.Result;
241
end CC70002;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.