1-- CA11012.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 child package of a library level instantiation
28--      of a generic can be the instantiation of a child package of
29--      the generic. Check that the child instance can use its parent's
30--      declarations and operations, including a formal type of the parent.
31--
32-- TEST DESCRIPTION:
33--      Declare a generic package which simulates an integer complex
34--      abstraction.  Declare a generic child package of this package
35--      which defines additional complex operations.
36--
37--      Instantiate the first generic package, then instantiate the child
38--      generic package as a child unit of the first instance.  In the main
39--      program, check that the operations in both instances perform as
40--      expected.
41--
42--
43-- CHANGE HISTORY:
44--      06 Dec 94   SAIC    ACVC 2.0
45--      21 Dec 94   SAIC    Corrected visibility errors for literals
46--      27 Feb 97   PWB.CTA Added elaboration pragma at package CA11012_3
47--!
48
49generic               -- Complex number abstraction.
50   type Int_Type is range <>;
51
52package CA11012_0 is
53
54   -- Simulate a generic complex number support package. Complex numbers
55   -- are treated as coordinates in the Cartesian plane.
56
57   type Complex_Type is private;
58
59   Zero : constant Complex_Type;                      -- Real number (0,0).
60
61   function Complex (Real, Imag : Int_Type)           -- Create a complex
62     return Complex_Type;                             -- number.
63
64   function "-" (Right : Complex_Type)                -- Invert a complex
65     return Complex_Type;                             -- number.
66
67   function "+" (Left, Right : Complex_Type)          -- Add two complex
68     return Complex_Type;                             -- numbers.
69
70private
71   type Complex_Type is record
72      Real : Int_Type;
73      Imag : Int_Type;
74   end record;
75
76   Zero : constant Complex_Type := (Real => 0, Imag => 0);
77
78end CA11012_0;
79
80     --==================================================================--
81
82package body CA11012_0 is
83
84   function Complex (Real, Imag : Int_Type) return Complex_Type is
85   begin
86      return (Real, Imag);
87   end Complex;
88   ---------------------------------------------------------------
89   function "-" (Right : Complex_Type) return Complex_Type is
90   begin
91      return (-Right.Real, -Right.Imag);
92   end "-";
93   ---------------------------------------------------------------
94   function "+" (Left, Right : Complex_Type) return Complex_Type is
95   begin
96      return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
97   end "+";
98
99end CA11012_0;
100
101     --==================================================================--
102
103-- Generic child of complex number package.  Child must be generic since
104-- parent is generic.
105
106generic               -- Complex additional operations
107
108package CA11012_0.CA11012_1 is
109
110   -- More operations on complex number. This child adds a layer of
111   -- functionality to the parent generic.
112
113   function Real_Part (Complex_No : Complex_Type)
114     return Int_Type;
115
116   function Imag_Part (Complex_No : Complex_Type)
117     return Int_Type;
118
119   function "*" (Factor : Int_Type;
120                 C      : Complex_Type) return Complex_Type;
121
122   function Vector_Magnitude (Complex_No : Complex_Type)
123     return Int_Type;
124
125end CA11012_0.CA11012_1;
126
127     --==================================================================--
128
129package body CA11012_0.CA11012_1 is
130
131   function Real_Part (Complex_No : Complex_Type) return Int_Type is
132   begin
133      return (Complex_No.Real);
134   end Real_Part;
135   ---------------------------------------------------------------
136   function Imag_Part (Complex_No : Complex_Type) return Int_Type is
137   begin
138      return (Complex_No.Imag);
139   end Imag_Part;
140   ---------------------------------------------------------------
141   function "*" (Factor : Int_Type;
142                 C      : Complex_Type) return Complex_Type is
143      Result : Complex_Type := Zero;   -- Zero is declared in parent,
144                                       -- Complex_Number
145   begin
146      for I in 1 .. abs (Factor) loop
147         Result := Result + C;         -- Complex_Number "+"
148      end loop;
149
150      if Factor < 0 then
151         Result := - Result;           -- Complex_Number "-"
152      end if;
153
154      return Result;
155   end "*";
156   ---------------------------------------------------------------
157   function Vector_Magnitude (Complex_No : Complex_Type)
158     return Int_Type is                -- Not a real vector magnitude.
159   begin
160      return (Complex_No.Real + Complex_No.Imag);
161   end Vector_Magnitude;
162
163end CA11012_0.CA11012_1;
164
165     --==================================================================--
166
167package CA11012_2 is
168
169   subtype My_Integer is integer range -100 .. 100;
170
171   -- ... Various other types used by the application.
172
173end CA11012_2;
174
175-- No body for CA11012_2;
176
177     --==================================================================--
178
179-- Declare instances of the generic complex packages for integer type.
180-- The instance of the child must itself be declared as a child of the
181-- instance of the parent.
182
183with CA11012_0;                        -- Complex number abstraction
184with CA11012_2;                        -- Package containing integer type
185pragma Elaborate (CA11012_0);
186package CA11012_3 is new CA11012_0 (Int_Type => CA11012_2.My_Integer);
187
188with CA11012_0.CA11012_1;              -- Complex additional operations
189with CA11012_3;
190package CA11012_3.CA11012_4 is new CA11012_3.CA11012_1;
191
192     --==================================================================--
193
194with CA11012_2;                -- Package containing integer type
195with CA11012_3.CA11012_4;      -- Complex abstraction + additional operations
196with Report;
197
198procedure CA11012 is
199
200   package My_Complex_Pkg renames CA11012_3;
201
202   package My_Complex_Operation renames CA11012_3.CA11012_4;
203
204   use My_Complex_Pkg,                                -- All user-defined
205       My_Complex_Operation;                          -- operators directly
206                                                      -- visible.
207   Complex_One, Complex_Two : Complex_Type;
208
209begin
210
211   Report.Test ("CA11012", "Check that child instance can use its parent's "  &
212                           "declarations and operations, including a formal " &
213                           "type of the parent");
214
215   Correct_Range_Test:
216   declare
217      My_Literal  : CA11012_2.My_Integer := -3;
218
219   begin
220      Complex_One := Complex (-4, 7);          -- Operation from the generic
221                                               -- parent package.
222
223      Complex_Two := My_Literal * Complex_One; -- Operation from the generic
224                                               -- child package.
225
226      if Real_Part (Complex_Two) /= 12         -- Operation from the generic
227        or Imag_Part (Complex_Two) /= -21      -- child package.
228          then
229             Report.Failed ("Incorrect results from complex operation");
230      end if;
231
232   end Correct_Range_Test;
233
234   ---------------------------------------------------------------
235
236   Out_Of_Range_Test:
237   declare
238      My_Vector : CA11012_2.My_Integer;
239
240   begin
241      Complex_One := Complex (70, 70);         -- Operation from the generic
242                                               -- parent package.
243      My_Vector := Vector_Magnitude (Complex_One);
244                     -- Operation from the generic child package.
245
246      Report.Failed ("Exception not raised in child package");
247
248   exception
249      when Constraint_Error =>
250        Report.Comment ("Exception is raised as expected");
251
252      when others           =>
253        Report.Failed ("Others exception is raised");
254
255   end Out_Of_Range_Test;
256
257   Report.Result;
258
259end CA11012;
260