diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca11001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca11001.a | 276 |
1 files changed, 0 insertions, 276 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca11001.a b/gcc/testsuite/ada/acats/tests/ca/ca11001.a deleted file mode 100644 index c9d1e486ca5..00000000000 --- a/gcc/testsuite/ada/acats/tests/ca/ca11001.a +++ /dev/null @@ -1,276 +0,0 @@ --- 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; |