1-- CA11001.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 unit can be used to provide an alternate view and
28--      operations on a private type in its parent package.  Check that a
29--      child unit can be a package.  Check that a WITH of a child unit
30--      includes an implicit WITH of its ancestor unit.
31--
32-- TEST DESCRIPTION:
33--      Declare a private type in a package specification. Declare
34--      subprograms for the type.
35--
36--      Add a public child to the above package.  Within the body of this
37--      package, access the private type. Declare operations to read and
38--      write to its parent private type.
39--
40--      In the main program, "with" the child.  Declare objects of the
41--      parent private type.  Access the subprograms from both parent and
42--      child packages.
43--
44--
45-- CHANGE HISTORY:
46--      06 Dec 94   SAIC    ACVC 2.0
47--
48--!
49
50package CA11001_0 is   -- Cartesian_Complex
51--  This package represents a Cartesian view of a complex number.  It contains
52--  a private type plus subprograms to construct and decompose a complex
53--  number.
54
55   type Complex_Int is range 0 .. 100;
56
57   type Complex_Type is private;
58
59   Constant_Complex : constant Complex_Type;
60
61   Complex_Error : exception;
62
63   procedure Cartesian_Assign   (R, I : in     Complex_Int;
64                                 C    :    out Complex_Type);
65
66   function Cartesian_Real_Part (C : Complex_Type)
67     return Complex_Int;
68
69   function Cartesian_Imag_Part (C : Complex_Type)
70     return Complex_Int;
71
72   function Complex (Real, Imaginary : Complex_Int)
73     return Complex_Type;
74
75private
76   type Complex_Type is                      -- Parent private type
77      record
78         Real, Imaginary : Complex_Int;
79      end record;
80
81   Constant_Complex : constant Complex_Type := (Real => 0, Imaginary => 0);
82
83end CA11001_0;       -- Cartesian_Complex
84
85--=======================================================================--
86
87package body CA11001_0 is  -- Cartesian_Complex
88
89   procedure Cartesian_Assign (R, I : in     Complex_Int;
90                               C    :    out Complex_Type) is
91   begin
92      C.Real      := R;
93      C.Imaginary := I;
94   end Cartesian_Assign;
95   -------------------------------------------------------------
96   function Cartesian_Real_Part (C : Complex_Type)
97     return Complex_Int is
98   begin
99      return C.Real;
100   end Cartesian_Real_Part;
101   -------------------------------------------------------------
102   function Cartesian_Imag_Part (C : Complex_Type)
103     return Complex_Int is
104   begin
105      return C.Imaginary;
106   end Cartesian_Imag_Part;
107   -------------------------------------------------------------
108   function Complex (Real, Imaginary : Complex_Int)
109     return Complex_Type is
110   begin
111      return (Real, Imaginary);
112   end Complex;
113
114end CA11001_0;      -- Cartesian_Complex
115
116--=======================================================================--
117
118package CA11001_0.CA11001_1 is    -- Polar_Complex
119--  This public child provides a different view of the private type from its
120--  parent.  It provides a polar view by the provision of subprograms which
121--  construct and decompose a complex number.
122
123   procedure Polar_Assign (R, Theta : in     Complex_Int;
124                           C        :    out Complex_Type);
125                                             -- Complex_Type is a
126                                             -- record of CA11001_0
127
128   function Polar_Real_Part (C: Complex_Type) return Complex_Int;
129
130   function Polar_Imag_Part (C: Complex_Type) return Complex_Int;
131
132   function Equals_Const (Num : Complex_Type) return Boolean;
133
134end CA11001_0.CA11001_1;    -- Polar_Complex
135
136--=======================================================================--
137
138package body CA11001_0.CA11001_1 is   -- Polar_Complex
139
140   function Cos (Angle : Complex_Int) return Complex_Int is
141      Num : constant Complex_Int := 2;
142   begin
143      return (Angle * Num);   -- not true Cosine function
144   end Cos;
145   -------------------------------------------------------------
146   function Sine (Angle : Complex_Int) return Complex_Int is
147   begin
148      return 1;     -- not true Sine function
149   end Sine;
150   -------------------------------------------------------------
151   function Sqrt (Num : Complex_Int)
152     return Complex_Int is
153   begin
154     return (Num);     -- not true Square root function
155   end Sqrt;
156   -------------------------------------------------------------
157   function Tan  (Angle : Complex_Int) return Complex_Int is
158   begin
159     return Angle;     -- not true Tangent function
160   end Tan;
161   -------------------------------------------------------------
162   procedure Polar_Assign (R, Theta : in     Complex_Int;
163                           C        :    out Complex_Type) is
164   begin
165      if R = 0 and Theta = 0 then
166         raise Complex_Error;
167      end if;
168      C.Real := R * Cos (Theta);
169      C.Imaginary := R * Sine (Theta);
170   end Polar_Assign;
171   -------------------------------------------------------------
172   function Polar_Real_Part (C: Complex_Type) return Complex_Int is
173   begin
174      return Sqrt ((Cartesian_Imag_Part (C)) ** 2 +
175                   (Cartesian_Real_Part (C)) ** 2);
176   end Polar_Real_Part;
177   -------------------------------------------------------------
178   function Polar_Imag_Part (C: Complex_Type) return Complex_Int is
179   begin
180      return (Tan (Cartesian_Imag_Part (C) /
181              Cartesian_Real_Part (C)));
182   end Polar_Imag_Part;
183   -------------------------------------------------------------
184   function Equals_Const (Num : Complex_Type) return Boolean is
185   begin
186      return Num.Real = Constant_Complex.Real and
187         Num.Imaginary = Constant_Complex.Imaginary;
188   end Equals_Const;
189
190end CA11001_0.CA11001_1;     -- Polar_Complex
191
192--=======================================================================--
193
194with CA11001_0.CA11001_1;        -- Polar_Complex
195with Report;
196
197procedure CA11001 is
198
199   Complex_No  : CA11001_0.Complex_Type;    -- Complex_Type is a
200                                            -- record of CA11001_0
201
202   Complex_5x2 : CA11001_0.Complex_Type := CA11001_0.Complex (5, 2);
203
204   Int_2       :  CA11001_0.Complex_Int
205               := CA11001_0.Complex_Int (Report.Ident_Int (2));
206
207begin
208
209   Report.Test ("CA11001", "Check that a child unit can be used " &
210                "to provide an alternate view and operations " &
211                "on a private type in its parent package");
212
213   Basic_View_Subtest:
214
215   begin
216      -- Assign using Cartesian coordinates.
217      CA11001_0.Cartesian_Assign
218        (CA11001_0.Complex_Int (Report.Ident_Int (1)), Int_2, Complex_No);
219
220      -- Read back in Polar coordinates.
221      -- Polar values are surrogates used in checking for correct
222      -- subprogram calls.
223      if CA11001_0."/=" (CA11001_0.CA11001_1.Polar_Real_Part (Complex_No),
224        CA11001_0.Cartesian_Real_Part (Complex_5x2)) and CA11001_0."/="
225          (CA11001_0.CA11001_1.Polar_Imag_Part (Complex_No),
226            CA11001_0.Cartesian_Imag_Part (Complex_5x2)) then
227           Report.Failed ("Incorrect Cartesian result");
228      end if;
229
230   end Basic_View_Subtest;
231   -------------------------------------------------------------
232   Alternate_View_Subtest:
233   begin
234      -- Assign using Polar coordinates.
235      CA11001_0.CA11001_1.Polar_Assign
236        (Int_2, CA11001_0.Complex_Int (Report.Ident_Int (3)), Complex_No);
237
238      -- Read back in Cartesian coordinates.
239      if CA11001_0."/=" (CA11001_0.Cartesian_Real_Part
240        (Complex_No), CA11001_0.Complex_Int (Report.Ident_Int (12))) or
241          CA11001_0."/=" (CA11001_0.Cartesian_Imag_Part (Complex_No), Int_2)
242      then
243         Report.Failed ("Incorrect Polar result");
244      end if;
245   end Alternate_View_Subtest;
246   -------------------------------------------------------------
247   Other_Subtest:
248   begin
249      -- Assign using Polar coordinates.
250      CA11001_0.CA11001_1.Polar_Assign
251        (CA11001_0.Complex_Int (Report.Ident_Int (0)), Int_2, Complex_No);
252
253      -- Compare with Complex_Num in CA11001_0.
254      if not CA11001_0.CA11001_1.Equals_Const (Complex_No)
255        then
256         Report.Failed ("Incorrect result");
257      end if;
258   end Other_Subtest;
259   -------------------------------------------------------------
260   Exception_Subtest:
261   begin
262      -- Raised parent's exception.
263      CA11001_0.CA11001_1.Polar_Assign
264        (CA11001_0.Complex_Int (Report.Ident_Int (0)),
265           CA11001_0.Complex_Int (Report.Ident_Int (0)), Complex_No);
266      Report.Failed ("Exception was not raised");
267   exception
268      when CA11001_0.Complex_Error =>
269         null;
270      when others                  =>
271         Report.Failed ("Unexpected exception raised in test");
272   end Exception_Subtest;
273
274   Report.Result;
275
276end CA11001;
277