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