1-- 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
52generic               -- Complex number abstraction.
53   type Int_Type is range <>;
54
55package 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
79private
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
87end CA11021_0;
88
89     --==================================================================--
90
91-- Private generic child of Complex_Number.
92
93private
94
95generic
96
97-- No parameter.
98
99package 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
112end CA11021_0.CA11021_1;
113
114     --==================================================================--
115
116package 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
132end CA11021_0.CA11021_1;
133
134     --==================================================================--
135
136with CA11021_0.CA11021_1;    -- Private generic child package.
137
138package 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
189end CA11021_0;
190
191     --==================================================================--
192
193with CA11021_0;                        -- Complex number abstraction.
194
195with Report;
196
197procedure 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
218begin
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
245end CA11021;
246