URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11001.a] - Rev 338
Compare with Previous | Blame | View Log
-- 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;