diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxg/cxg2009.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxg/cxg2009.a | 421 |
1 files changed, 0 insertions, 421 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a deleted file mode 100644 index 0b11ca53887..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a +++ /dev/null @@ -1,421 +0,0 @@ --- CXG2009.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 the real sqrt and complex modulus functions --- return results that are within the allowed --- error bound. --- --- TEST DESCRIPTION: --- This test checks the accuracy of the sqrt and modulus functions --- by computing the norm of various vectors where the result --- is known in advance. --- This test uses real and complex math together as would an --- actual application. Considerable use of generics is also --- employed. --- --- SPECIAL REQUIREMENTS --- The Strict Mode for the numerical accuracy must be --- selected. The method by which this mode is selected --- is implementation dependent. --- --- APPLICABILITY CRITERIA: --- This test applies only to implementations supporting the --- Numerics Annex. --- This test only applies to the Strict Mode for numerical --- accuracy. --- --- --- CHANGE HISTORY: --- 26 FEB 96 SAIC Initial release for 2.1 --- 22 AUG 96 SAIC Revised Check procedure --- ---! - ------------------------------------------------------------------------------- - -with System; -with Report; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Generic_Elementary_Functions; -procedure CXG2009 is - Verbose : constant Boolean := False; - - --===================================================================== - - generic - type Real is digits <>; - package Generic_Real_Norm_Check is - procedure Do_Test; - end Generic_Real_Norm_Check; - - ----------------------------------------------------------------------- - - package body Generic_Real_Norm_Check is - type Vector is array (Integer range <>) of Real; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real) return Real renames GEF.Sqrt; - - function One_Norm (V : Vector) return Real is - -- sum of absolute values of the elements of the vector - Result : Real := 0.0; - begin - for I in V'Range loop - Result := Result + abs V(I); - end loop; - return Result; - end One_Norm; - - function Inf_Norm (V : Vector) return Real is - -- greatest absolute vector element - Result : Real := 0.0; - begin - for I in V'Range loop - if abs V(I) > Result then - Result := abs V(I); - end if; - end loop; - return Result; - end Inf_Norm; - - function Two_Norm (V : Vector) return Real is - -- if greatest absolute vector element is 0 then return 0 - -- else return greatest * sqrt (sum((element / greatest) ** 2))) - -- where greatest is Inf_Norm of the vector - Inf_N : Real; - Sum_Squares : Real; - Term : Real; - begin - Inf_N := Inf_Norm (V); - if Inf_N = 0.0 then - return 0.0; - end if; - Sum_Squares := 0.0; - for I in V'Range loop - Term := V (I) / Inf_N; - Sum_Squares := Sum_Squares + Term * Term; - end loop; - return Inf_N * Sqrt (Sum_Squares); - end Two_Norm; - - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real; - Vector_Length : Integer) is - Rel_Error : Real; - Abs_Error : Real; - Max_Error : Real; - begin - -- In the case where the expected result is very small or 0 - -- we compute the maximum error as a multiple of Model_Epsilon instead - -- of Model_Epsilon and Expected. - Rel_Error := MRE * abs Expected * Real'Model_Epsilon; - Abs_Error := MRE * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - - if abs (Actual - Expected) > Max_Error then - Report.Failed (Test_Name & - " VectLength:" & - Integer'Image (Vector_Length) & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Actual - Expected) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - Report.Comment (Test_Name & " vector length" & - Integer'Image (Vector_Length)); - end if; - end Check; - - - procedure Do_Test is - begin - for Vector_Length in 1 .. 10 loop - declare - V : Vector (1..Vector_Length) := (1..Vector_Length => 0.0); - V1 : Vector (1..Vector_Length) := (1..Vector_Length => 1.0); - begin - Check (One_Norm (V), 0.0, "one_norm (z)", 0.0, Vector_Length); - Check (Inf_Norm (V), 0.0, "inf_norm (z)", 0.0, Vector_Length); - - for J in 1..Vector_Length loop - V := (1..Vector_Length => 0.0); - V (J) := 1.0; - Check (One_Norm (V), 1.0, "one_norm (010)", - 0.0, Vector_Length); - Check (Inf_Norm (V), 1.0, "inf_norm (010)", - 0.0, Vector_Length); - Check (Two_Norm (V), 1.0, "two_norm (010)", - 0.0, Vector_Length); - end loop; - - Check (One_Norm (V1), Real (Vector_Length), "one_norm (1)", - 0.0, Vector_Length); - Check (Inf_Norm (V1), 1.0, "inf_norm (1)", - 0.0, Vector_Length); - - -- error in computing Two_Norm and expected result - -- are as follows (ME is Model_Epsilon * Expected_Value): - -- 2ME from expected Sqrt - -- 2ME from Sqrt in Two_Norm times the error in the - -- vector calculation. - -- The vector calculation contains the following error - -- based upon the length N of the vector: - -- N*1ME from squaring terms in Two_Norm - -- N*1ME from the division of each term in Two_Norm - -- (N-1)*1ME from the sum of the terms - -- This gives (2 + 2 * (N + N + (N-1)) ) * ME - -- which simplifies to (2 + 2N + 2N + 2N - 2) * ME - -- or 6*N*ME - Check (Two_Norm (V1), Sqrt (Real(Vector_Length)), - "two_norm (1)", - (Real (6 * Vector_Length)), - Vector_Length); - exception - when others => Report.Failed ("exception for vector length" & - Integer'Image (Vector_Length) ); - end; - end loop; - end Do_Test; - end Generic_Real_Norm_Check; - - --===================================================================== - - generic - type Real is digits <>; - package Generic_Complex_Norm_Check is - procedure Do_Test; - end Generic_Complex_Norm_Check; - - ----------------------------------------------------------------------- - - package body Generic_Complex_Norm_Check is - package Complex_Types is new Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Types; - type Vector is array (Integer range <>) of Complex; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real) return Real renames GEF.Sqrt; - - function One_Norm (V : Vector) return Real is - Result : Real := 0.0; - begin - for I in V'Range loop - Result := Result + abs V(I); - end loop; - return Result; - end One_Norm; - - function Inf_Norm (V : Vector) return Real is - Result : Real := 0.0; - begin - for I in V'Range loop - if abs V(I) > Result then - Result := abs V(I); - end if; - end loop; - return Result; - end Inf_Norm; - - function Two_Norm (V : Vector) return Real is - Inf_N : Real; - Sum_Squares : Real; - Term : Real; - begin - Inf_N := Inf_Norm (V); - if Inf_N = 0.0 then - return 0.0; - end if; - Sum_Squares := 0.0; - for I in V'Range loop - Term := abs (V (I) / Inf_N ); - Sum_Squares := Sum_Squares + Term * Term; - end loop; - return Inf_N * Sqrt (Sum_Squares); - end Two_Norm; - - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real; - Vector_Length : Integer) is - Rel_Error : Real; - Abs_Error : Real; - Max_Error : Real; - begin - -- In the case where the expected result is very small or 0 - -- we compute the maximum error as a multiple of Model_Epsilon instead - -- of Model_Epsilon and Expected. - Rel_Error := MRE * abs Expected * Real'Model_Epsilon; - Abs_Error := MRE * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - - if abs (Actual - Expected) > Max_Error then - Report.Failed (Test_Name & - " VectLength:" & - Integer'Image (Vector_Length) & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Actual - Expected) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - Report.Comment (Test_Name & " vector length" & - Integer'Image (Vector_Length)); - end if; - end Check; - - - procedure Do_Test is - begin - for Vector_Length in 1 .. 10 loop - declare - V : Vector (1..Vector_Length) := - (1..Vector_Length => (0.0, 0.0)); - X, Y : Vector (1..Vector_Length); - begin - Check (One_Norm (V), 0.0, "one_norm (z)", 0.0, Vector_Length); - Check (Inf_Norm (V), 0.0, "inf_norm (z)", 0.0, Vector_Length); - - for J in 1..Vector_Length loop - X := (1..Vector_Length => (0.0, 0.0) ); - Y := X; -- X and Y are now both zeroed - X (J).Re := 1.0; - Y (J).Im := 1.0; - Check (One_Norm (X), 1.0, "one_norm (0x0)", - 0.0, Vector_Length); - Check (Inf_Norm (X), 1.0, "inf_norm (0x0)", - 0.0, Vector_Length); - Check (Two_Norm (X), 1.0, "two_norm (0x0)", - 0.0, Vector_Length); - Check (One_Norm (Y), 1.0, "one_norm (0y0)", - 0.0, Vector_Length); - Check (Inf_Norm (Y), 1.0, "inf_norm (0y0)", - 0.0, Vector_Length); - Check (Two_Norm (Y), 1.0, "two_norm (0y0)", - 0.0, Vector_Length); - end loop; - - V := (1..Vector_Length => (3.0, 4.0)); - - -- error in One_Norm is 3*N*ME for abs computation + - -- (N-1)*ME for the additions - -- which gives (4N-1) * ME - Check (One_Norm (V), 5.0 * Real (Vector_Length), - "one_norm ((3,4))", - Real (4*Vector_Length - 1), - Vector_Length); - - -- error in Inf_Norm is from abs of single element (3ME) - Check (Inf_Norm (V), 5.0, - "inf_norm ((3,4))", - 3.0, - Vector_Length); - - -- error in following comes from: - -- 2ME in sqrt of expected result - -- 3ME in Inf_Norm calculation - -- 2ME in sqrt of vector calculation - -- vector calculation has following error - -- 3N*ME for abs - -- N*ME for squaring - -- N*ME for division - -- (N-1)ME for sum - -- this results in [2 + 3 + 2(6N-1) ] * ME - -- or (12N + 3)ME - Check (Two_Norm (V), 5.0 * Sqrt (Real(Vector_Length)), - "two_norm ((3,4))", - (12.0 * Real (Vector_Length) + 3.0), - Vector_Length); - exception - when others => Report.Failed ("exception for complex " & - "vector length" & - Integer'Image (Vector_Length) ); - end; - end loop; - end Do_Test; - end Generic_Complex_Norm_Check; - - --===================================================================== - - generic - type Real is digits <>; - package Generic_Norm_Check is - procedure Do_Test; - end Generic_Norm_Check; - - ----------------------------------------------------------------------- - - package body Generic_Norm_Check is - package RNC is new Generic_Real_Norm_Check (Real); - package CNC is new Generic_Complex_Norm_Check (Real); - procedure Do_Test is - begin - RNC.Do_Test; - CNC.Do_Test; - end Do_Test; - end Generic_Norm_Check; - - --===================================================================== - - package Float_Check is new Generic_Norm_Check (Float); - - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Norm_Check (A_Long_Float); - - ----------------------------------------------------------------------- - -begin - Report.Test ("CXG2009", - "Check the accuracy of the real sqrt and complex " & - " modulus functions"); - - if Verbose then - Report.Comment ("checking Standard.Float"); - end if; - - Float_Check.Do_Test; - - if Verbose then - Report.Comment ("checking a digits" & - Integer'Image (System.Max_Digits) & - " floating point type"); - end if; - - A_Long_Float_Check.Do_Test; - - Report.Result; -end CXG2009; |