| -- CA11001.A |
| -- |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- |
| -- OBJECTIVE: |
| -- Check that a child unit can be used to provide an alternate view and |
| -- operations on a private type in its parent package. Check that a |
| -- child unit can be a package. Check that a WITH of a child unit |
| -- includes an implicit WITH of its ancestor unit. |
| -- |
| -- TEST DESCRIPTION: |
| -- Declare a private type in a package specification. Declare |
| -- subprograms for the type. |
| -- |
| -- Add a public child to the above package. Within the body of this |
| -- package, access the private type. Declare operations to read and |
| -- write to its parent private type. |
| -- |
| -- In the main program, "with" the child. Declare objects of the |
| -- parent private type. Access the subprograms from both parent and |
| -- child packages. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- |
| --! |
| |
| package CA11001_0 is -- Cartesian_Complex |
| -- This package represents a Cartesian view of a complex number. It contains |
| -- a private type plus subprograms to construct and decompose a complex |
| -- number. |
| |
| type Complex_Int is range 0 .. 100; |
| |
| type Complex_Type is private; |
| |
| Constant_Complex : constant Complex_Type; |
| |
| Complex_Error : exception; |
| |
| procedure Cartesian_Assign (R, I : in Complex_Int; |
| C : out Complex_Type); |
| |
| function Cartesian_Real_Part (C : Complex_Type) |
| return Complex_Int; |
| |
| function Cartesian_Imag_Part (C : Complex_Type) |
| return Complex_Int; |
| |
| function Complex (Real, Imaginary : Complex_Int) |
| return Complex_Type; |
| |
| private |
| type Complex_Type is -- Parent private type |
| record |
| Real, Imaginary : Complex_Int; |
| end record; |
| |
| Constant_Complex : constant Complex_Type := (Real => 0, Imaginary => 0); |
| |
| end CA11001_0; -- Cartesian_Complex |
| |
| --=======================================================================-- |
| |
| package body CA11001_0 is -- Cartesian_Complex |
| |
| procedure Cartesian_Assign (R, I : in Complex_Int; |
| C : out Complex_Type) is |
| begin |
| C.Real := R; |
| C.Imaginary := I; |
| end Cartesian_Assign; |
| ------------------------------------------------------------- |
| function Cartesian_Real_Part (C : Complex_Type) |
| return Complex_Int is |
| begin |
| return C.Real; |
| end Cartesian_Real_Part; |
| ------------------------------------------------------------- |
| function Cartesian_Imag_Part (C : Complex_Type) |
| return Complex_Int is |
| begin |
| return C.Imaginary; |
| end Cartesian_Imag_Part; |
| ------------------------------------------------------------- |
| function Complex (Real, Imaginary : Complex_Int) |
| return Complex_Type is |
| begin |
| return (Real, Imaginary); |
| end Complex; |
| |
| end CA11001_0; -- Cartesian_Complex |
| |
| --=======================================================================-- |
| |
| package CA11001_0.CA11001_1 is -- Polar_Complex |
| -- This public child provides a different view of the private type from its |
| -- parent. It provides a polar view by the provision of subprograms which |
| -- construct and decompose a complex number. |
| |
| procedure Polar_Assign (R, Theta : in Complex_Int; |
| C : out Complex_Type); |
| -- Complex_Type is a |
| -- record of CA11001_0 |
| |
| function Polar_Real_Part (C: Complex_Type) return Complex_Int; |
| |
| function Polar_Imag_Part (C: Complex_Type) return Complex_Int; |
| |
| function Equals_Const (Num : Complex_Type) return Boolean; |
| |
| end CA11001_0.CA11001_1; -- Polar_Complex |
| |
| --=======================================================================-- |
| |
| package body CA11001_0.CA11001_1 is -- Polar_Complex |
| |
| function Cos (Angle : Complex_Int) return Complex_Int is |
| Num : constant Complex_Int := 2; |
| begin |
| return (Angle * Num); -- not true Cosine function |
| end Cos; |
| ------------------------------------------------------------- |
| function Sine (Angle : Complex_Int) return Complex_Int is |
| begin |
| return 1; -- not true Sine function |
| end Sine; |
| ------------------------------------------------------------- |
| function Sqrt (Num : Complex_Int) |
| return Complex_Int is |
| begin |
| return (Num); -- not true Square root function |
| end Sqrt; |
| ------------------------------------------------------------- |
| function Tan (Angle : Complex_Int) return Complex_Int is |
| begin |
| return Angle; -- not true Tangent function |
| end Tan; |
| ------------------------------------------------------------- |
| procedure Polar_Assign (R, Theta : in Complex_Int; |
| C : out Complex_Type) is |
| begin |
| if R = 0 and Theta = 0 then |
| raise Complex_Error; |
| end if; |
| C.Real := R * Cos (Theta); |
| C.Imaginary := R * Sine (Theta); |
| end Polar_Assign; |
| ------------------------------------------------------------- |
| function Polar_Real_Part (C: Complex_Type) return Complex_Int is |
| begin |
| return Sqrt ((Cartesian_Imag_Part (C)) ** 2 + |
| (Cartesian_Real_Part (C)) ** 2); |
| end Polar_Real_Part; |
| ------------------------------------------------------------- |
| function Polar_Imag_Part (C: Complex_Type) return Complex_Int is |
| begin |
| return (Tan (Cartesian_Imag_Part (C) / |
| Cartesian_Real_Part (C))); |
| end Polar_Imag_Part; |
| ------------------------------------------------------------- |
| function Equals_Const (Num : Complex_Type) return Boolean is |
| begin |
| return Num.Real = Constant_Complex.Real and |
| Num.Imaginary = Constant_Complex.Imaginary; |
| end Equals_Const; |
| |
| end CA11001_0.CA11001_1; -- Polar_Complex |
| |
| --=======================================================================-- |
| |
| with CA11001_0.CA11001_1; -- Polar_Complex |
| with Report; |
| |
| procedure CA11001 is |
| |
| Complex_No : CA11001_0.Complex_Type; -- Complex_Type is a |
| -- record of CA11001_0 |
| |
| Complex_5x2 : CA11001_0.Complex_Type := CA11001_0.Complex (5, 2); |
| |
| Int_2 : CA11001_0.Complex_Int |
| := CA11001_0.Complex_Int (Report.Ident_Int (2)); |
| |
| begin |
| |
| Report.Test ("CA11001", "Check that a child unit can be used " & |
| "to provide an alternate view and operations " & |
| "on a private type in its parent package"); |
| |
| Basic_View_Subtest: |
| |
| begin |
| -- Assign using Cartesian coordinates. |
| CA11001_0.Cartesian_Assign |
| (CA11001_0.Complex_Int (Report.Ident_Int (1)), Int_2, Complex_No); |
| |
| -- Read back in Polar coordinates. |
| -- Polar values are surrogates used in checking for correct |
| -- subprogram calls. |
| if CA11001_0."/=" (CA11001_0.CA11001_1.Polar_Real_Part (Complex_No), |
| CA11001_0.Cartesian_Real_Part (Complex_5x2)) and CA11001_0."/=" |
| (CA11001_0.CA11001_1.Polar_Imag_Part (Complex_No), |
| CA11001_0.Cartesian_Imag_Part (Complex_5x2)) then |
| Report.Failed ("Incorrect Cartesian result"); |
| end if; |
| |
| end Basic_View_Subtest; |
| ------------------------------------------------------------- |
| Alternate_View_Subtest: |
| begin |
| -- Assign using Polar coordinates. |
| CA11001_0.CA11001_1.Polar_Assign |
| (Int_2, CA11001_0.Complex_Int (Report.Ident_Int (3)), Complex_No); |
| |
| -- Read back in Cartesian coordinates. |
| if CA11001_0."/=" (CA11001_0.Cartesian_Real_Part |
| (Complex_No), CA11001_0.Complex_Int (Report.Ident_Int (12))) or |
| CA11001_0."/=" (CA11001_0.Cartesian_Imag_Part (Complex_No), Int_2) |
| then |
| Report.Failed ("Incorrect Polar result"); |
| end if; |
| end Alternate_View_Subtest; |
| ------------------------------------------------------------- |
| Other_Subtest: |
| begin |
| -- Assign using Polar coordinates. |
| CA11001_0.CA11001_1.Polar_Assign |
| (CA11001_0.Complex_Int (Report.Ident_Int (0)), Int_2, Complex_No); |
| |
| -- Compare with Complex_Num in CA11001_0. |
| if not CA11001_0.CA11001_1.Equals_Const (Complex_No) |
| then |
| Report.Failed ("Incorrect result"); |
| end if; |
| end Other_Subtest; |
| ------------------------------------------------------------- |
| Exception_Subtest: |
| begin |
| -- Raised parent's exception. |
| CA11001_0.CA11001_1.Polar_Assign |
| (CA11001_0.Complex_Int (Report.Ident_Int (0)), |
| CA11001_0.Complex_Int (Report.Ident_Int (0)), Complex_No); |
| Report.Failed ("Exception was not raised"); |
| exception |
| when CA11001_0.Complex_Error => |
| null; |
| when others => |
| Report.Failed ("Unexpected exception raised in test"); |
| end Exception_Subtest; |
| |
| Report.Result; |
| |
| end CA11001; |
