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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11021.a] - Blame information for rev 867

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CA11021.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 body of the generic parent package can depend on one of
28
--      its own private generic children.
29
--
30
-- TEST DESCRIPTION:
31
--      A scenario is created that demonstrates the potential of adding a
32
--      public generic child during code maintenance without distubing a large
33
--      subsystem.  After child is added to the subsystem, a maintainer
34
--      decides to take advantage of the new functionality and rewrites
35
--      the parent's body.
36
--
37
--      Declare a generic package which declares high level operations for a
38
--      complex number abstraction.  Declare a private generic child package
39
--      of this package which defines low level complex operations. In the
40
--      parent body, instantiate the private child.  Use the low level
41
--      operation to complete the high level operation.
42
--
43
--      In the main program, instantiate the parent generic package.
44
--      Check that the operations in both packages perform as expected.
45
--
46
--
47
-- CHANGE HISTORY:
48
--      06 Dec 94   SAIC    ACVC 2.0
49
--
50
--!
51
 
52
generic               -- Complex number abstraction.
53
   type Int_Type is range <>;
54
 
55
package CA11021_0 is
56
 
57
   -- Simulate a generic complex number support package. Complex numbers
58
   -- are treated as coordinates in the Cartesian plane.
59
 
60
   type Complex_Type is private;
61
 
62
   Zero : constant Complex_Type;                      -- Real number (0,0).
63
 
64
   function Real_Part (Complex_No : Complex_Type)
65
     return Int_Type;
66
 
67
   function Imag_Part (Complex_No : Complex_Type)
68
     return Int_Type;
69
 
70
   function Complex (Real, Imag : Int_Type)
71
     return Complex_Type;
72
 
73
   -- High level operation for complex number.
74
   function "*" (Factor : Int_Type;
75
                 C      : Complex_Type) return Complex_Type;
76
 
77
   -- ... and other complicated ones.
78
 
79
private
80
   type Complex_Type is record
81
      Real : Int_Type;
82
      Imag : Int_Type;
83
   end record;
84
 
85
   Zero : constant Complex_Type := (Real => 0, Imag => 0);
86
 
87
end CA11021_0;
88
 
89
     --==================================================================--
90
 
91
-- Private generic child of Complex_Number.
92
 
93
private
94
 
95
generic
96
 
97
-- No parameter.
98
 
99
package CA11021_0.CA11021_1 is
100
 
101
   -- ... Other declarations.
102
 
103
   -- Low level operation on complex number.
104
   function "+" (Left, Right : Complex_Type)
105
     return Complex_Type;
106
 
107
   function "-" (Right : Complex_Type)
108
     return Complex_Type;
109
 
110
   -- ... Various other operations in real application.
111
 
112
end CA11021_0.CA11021_1;
113
 
114
     --==================================================================--
115
 
116
package body CA11021_0.CA11021_1 is
117
 
118
   function "+" (Left, Right : Complex_Type)
119
     return Complex_Type is
120
 
121
   begin
122
      return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
123
   end "+";
124
 
125
               --------------------------------------------------
126
 
127
   function "-" (Right : Complex_Type) return Complex_Type is
128
   begin
129
      return (-Right.Real, -Right.Imag);
130
   end "-";
131
 
132
end CA11021_0.CA11021_1;
133
 
134
     --==================================================================--
135
 
136
with CA11021_0.CA11021_1;    -- Private generic child package.
137
 
138
package body CA11021_0 is
139
 
140
   -----------------------------------------------------
141
   -- Parent's body depends on private generic child. --
142
   -----------------------------------------------------
143
 
144
   -- Instantiate the private child.
145
 
146
   package Complex_Ops is new CA11021_1;
147
   use Complex_Ops;                    -- All user-defined operators
148
                                       -- directly visible.
149
 
150
               --------------------------------------------------
151
 
152
   function "*" (Factor : Int_Type;
153
                 C      : Complex_Type) return Complex_Type is
154
      Result : Complex_Type := Zero;
155
 
156
   begin
157
      for I in 1 .. abs (Factor) loop
158
         Result := Result + C;         -- Private generic child "+".
159
      end loop;
160
 
161
      if Factor < 0 then
162
         Result := - Result;           -- Private generic child "-".
163
      end if;
164
 
165
      return Result;
166
   end "*";
167
 
168
               --------------------------------------------------
169
 
170
   function Real_Part (Complex_No : Complex_Type) return Int_Type is
171
   begin
172
      return (Complex_No.Real);
173
   end Real_Part;
174
 
175
               --------------------------------------------------
176
 
177
   function Imag_Part (Complex_No : Complex_Type) return Int_Type is
178
   begin
179
      return (Complex_No.Imag);
180
   end Imag_Part;
181
 
182
               --------------------------------------------------
183
 
184
   function Complex (Real, Imag : Int_Type) return Complex_Type is
185
   begin
186
      return (Real, Imag);
187
   end Complex;
188
 
189
end CA11021_0;
190
 
191
     --==================================================================--
192
 
193
with CA11021_0;                        -- Complex number abstraction.
194
 
195
with Report;
196
 
197
procedure CA11021 is
198
 
199
   type My_Integer is range -100 .. 100;
200
 
201
               --------------------------------------------------
202
 
203
-- Declare instance of the generic complex package for one particular
204
-- integer type.
205
 
206
   package My_Complex_Pkg is new
207
     CA11021_0 (Int_Type => My_Integer);
208
 
209
   use My_Complex_Pkg;                 -- All user-defined operators
210
                                       -- directly visible.
211
 
212
               --------------------------------------------------
213
 
214
   Complex_One, Complex_Two : Complex_Type;
215
 
216
   My_Literal               : My_Integer := -3;
217
 
218
begin
219
 
220
   Report.Test ("CA11021", "Check that body of the generic parent package " &
221
                "can depend on its private generic child");
222
 
223
   Complex_One := Complex (11, 6);
224
 
225
   Complex_Two := 5 * Complex_One;
226
 
227
   if Real_Part (Complex_Two) /= 55
228
     and Imag_Part (Complex_Two) /= 30
229
        then
230
           Report.Failed ("Incorrect results from complex operation");
231
   end if;
232
 
233
   Complex_One := Complex (-4, 7);
234
 
235
   Complex_Two := My_Literal * Complex_One;
236
 
237
   if Real_Part (Complex_Two) /= 12
238
     and Imag_Part (Complex_Two) /= -21
239
        then
240
           Report.Failed ("Incorrect results from complex operation");
241
   end if;
242
 
243
   Report.Result;
244
 
245
end CA11021;

powered by: WebSVN 2.1.0

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