diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxg')
29 files changed, 0 insertions, 12171 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a b/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a deleted file mode 100644 index 01a0f061e51..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a +++ /dev/null @@ -1,276 +0,0 @@ --- CXG1001.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 subprograms defined in the package --- Ada.Numerics.Generic_Complex_Types provide correct results. --- Specifically, check the functions Re, Im (both versions), procedures --- Set_Re, Set_Im (both versions), functions Compose_From_Cartesian (all --- versions), Compose_From_Polar, Modulus, Argument, and "abs". --- --- TEST DESCRIPTION: --- The generic package Generic_Complex_Types --- is instantiated with a real type (new Float), and the results --- produced by the specified subprograms are verified. --- --- APPLICABILITY CRITERIA: --- This test applies only to implementations supporting the --- Numerics Annex. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 15 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1. --- Modified subtest for Compose_From_Polar. --- 29 Sep 96 SAIC Incorporated reviewer comments. --- ---! - -with Ada.Numerics.Generic_Complex_Types; -with Report; - -procedure CXG1001 is - -begin - - Report.Test ("CXG1001", "Check that the subprograms defined in " & - "the package Ada.Numerics.Generic_Complex_Types " & - "provide correct results"); - - Test_Block: - declare - - type Real_Type is new Float; - - package Complex_Pack is new - Ada.Numerics.Generic_Complex_Types(Real_Type); - - use type Complex_Pack.Complex; - - -- Declare a zero valued complex number. - Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0); - - TC_Complex : Complex_Pack.Complex := Complex_Zero; - TC_Imaginary : Complex_Pack.Imaginary; - - begin - - -- Check that the procedures Set_Re and Set_Im (both versions) provide - -- correct results. - - declare - TC_Complex_Real_Field : Complex_Pack.Complex := (5.0, 0.0); - TC_Complex_Both_Fields : Complex_Pack.Complex := (5.0, 7.0); - begin - - Complex_Pack.Set_Re(X => TC_Complex, Re => 5.0); - - if TC_Complex /= TC_Complex_Real_Field then - Report.Failed("Incorrect results from Procedure Set_Re"); - end if; - - Complex_Pack.Set_Im(X => TC_Complex, Im => 7.0); - - if TC_Complex.Re /= 5.0 or - TC_Complex.Im /= 7.0 or - TC_Complex /= TC_Complex_Both_Fields - then - Report.Failed("Incorrect results from Procedure Set_Im " & - "with Complex argument"); - end if; - - Complex_Pack.Set_Im(X => TC_Imaginary, Im => 3.0); - - - if Complex_Pack.Im(TC_Imaginary) /= 3.0 then - Report.Failed("Incorrect results returned following the use " & - "of Procedure Set_Im with Imaginary argument"); - end if; - - end; - - - -- Check that the functions Re and Im (both versions) provide - -- correct results. - - declare - TC_Complex_1 : Complex_Pack.Complex := (1.0, 0.0); - TC_Complex_2 : Complex_Pack.Complex := (0.0, 2.0); - TC_Complex_3 : Complex_Pack.Complex := (4.0, 3.0); - begin - - -- Function Re. - - if Complex_Pack.Re(X => TC_Complex_1) /= 1.0 or - Complex_Pack.Re(X => TC_Complex_2) /= 0.0 or - Complex_Pack.Re(X => TC_Complex_3) /= 4.0 - then - Report.Failed("Incorrect results from Function Re"); - end if; - - -- Function Im; version with Complex argument. - - if Complex_Pack.Im(X => TC_Complex_1) /= 0.0 or - Complex_Pack.Im(X => TC_Complex_2) /= 2.0 or - Complex_Pack.Im(X => TC_Complex_3) /= 3.0 - then - Report.Failed("Incorrect results from Function Im " & - "with Complex argument"); - end if; - - - -- Function Im; version with Imaginary argument. - - if Complex_Pack.Im(Complex_Pack.i) /= 1.0 or - Complex_Pack.Im(Complex_Pack.j) /= 1.0 - then - Report.Failed("Incorrect results from use of Function Im " & - "when used with an Imaginary argument"); - end if; - - end; - - - -- Verify the results of the three versions of Function - -- Compose_From_Cartesian - - declare - - Zero : constant Real_Type := 0.0; - Six : constant Real_Type := 6.0; - - TC_Complex_1 : Complex_Pack.Complex := (3.0, 8.0); - TC_Complex_2 : Complex_Pack.Complex := (Six, Zero); - TC_Complex_3 : Complex_Pack.Complex := (Zero, 1.0); - - begin - - TC_Complex := Complex_Pack.Compose_From_Cartesian(3.0, 8.0); - - if TC_Complex /= TC_Complex_1 then - Report.Failed("Incorrect results from Function " & - "Compose_From_Cartesian - 1"); - end if; - - -- If only one component is given, the other component is - -- implicitly zero (Both components are set by the following two - -- function calls). - - TC_Complex := Complex_Pack.Compose_From_Cartesian(Re => 6.0); - - if TC_Complex /= TC_Complex_2 then - Report.Failed("Incorrect results from Function " & - "Compose_From_Cartesian - 2"); - end if; - - TC_Complex := - Complex_Pack.Compose_From_Cartesian(Im => Complex_Pack.i); - - if TC_Complex /= TC_Complex_3 then - Report.Failed("Incorrect results from Function " & - "Compose_From_Cartesian - 3"); - end if; - - end; - - - -- Verify the results of Function Compose_From_Polar, Modulus, "abs", - -- and Argument. - - declare - - use Complex_Pack; - - TC_Modulus, - TC_Argument : Real_Type := 0.0; - - - Angle_0 : constant Real_Type := 0.0; - Angle_90 : constant Real_Type := 90.0; - Angle_180 : constant Real_Type := 180.0; - Angle_270 : constant Real_Type := 270.0; - Angle_360 : constant Real_Type := 360.0; - - begin - - -- Verify the result of Function Compose_From_Polar. - -- When the value of the parameter Modulus is zero, the - -- Compose_From_Polar function yields a result of zero. - - if Compose_From_Polar(0.0, 30.0, 360.0) /= Complex_Zero - then - Report.Failed("Incorrect result from Function " & - "Compose_From_Polar - 1"); - end if; - - -- When the value of the parameter Argument is equal to a multiple - -- of the quarter cycle, the result of the Compose_From_Polar - -- function with specified cycle lies on one of the axes. - - if Compose_From_Polar( 5.0, Angle_0, Angle_360) /= (5.0, 0.0) or - Compose_From_Polar( 5.0, Angle_90, Angle_360) /= (0.0, 5.0) or - Compose_From_Polar(-5.0, Angle_180, Angle_360) /= (5.0, 0.0) or - Compose_From_Polar(-5.0, Angle_270, Angle_360) /= (0.0, 5.0) or - Compose_From_Polar(-5.0, Angle_90, Angle_360) /= (0.0, -5.0) or - Compose_From_Polar( 5.0, Angle_270, Angle_360) /= (0.0, -5.0) - then - Report.Failed("Incorrect result from Function " & - "Compose_From_Polar - 2"); - end if; - - -- When the parameter to Function Argument represents a point on - -- the non-negative real axis, the function yields a zero result. - - if Argument(Complex_Zero, Angle_360) /= 0.0 then - Report.Failed("Incorrect result from Function Argument"); - end if; - - -- Function Modulus - - if Modulus(Complex_Zero) /= 0.0 or - Modulus(Compose_From_Polar( 5.0, Angle_90, Angle_360)) /= 5.0 or - Modulus(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0 - then - Report.Failed("Incorrect results from Function Modulus"); - end if; - - -- Function "abs", a rename of Function Modulus. - - if "abs"(Complex_Zero) /= 0.0 or - "abs"(Compose_From_Polar( 5.0, Angle_90, Angle_360)) /= 5.0 or - "abs"(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0 - then - Report.Failed("Incorrect results from Function abs"); - end if; - - end; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXG1001; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a b/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a deleted file mode 100644 index 39f5f00dbc3..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a +++ /dev/null @@ -1,198 +0,0 @@ --- CXG1002.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 subprograms defined in the package --- Ada.Numerics.Generic_Complex_Types provide the prescribed results. --- Specifically, check the various versions of functions "+" and "-". --- --- TEST DESCRIPTION: --- This test checks that the subprograms "+" and "-" defined in the --- Generic_Complex_Types package provide the results prescribed for the --- evaluation of these complex arithmetic operations. The functions --- Re and Im are used to extract the appropriate component of the --- complex result, in order that the prescribed result component can be --- verified. --- The generic package is instantiated with a real type (new Float), --- and the results produced by the specified subprograms are verified. --- --- SPECIAL REQUIREMENTS: --- This test can be run in either "relaxed" or "strict" mode. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Ada.Numerics.Generic_Complex_Types; -with Report; - -procedure CXG1002 is - -begin - - Report.Test ("CXG1002", "Check that the subprograms defined in " & - "the package Ada.Numerics.Generic_Complex_Types " & - "provide the prescribed results"); - - Test_Block: - declare - - type Real_Type is new Float; - - package Complex_Pack is new - Ada.Numerics.Generic_Complex_Types(Real_Type); - use Complex_Pack; - - -- Declare a zero valued complex number using the record - -- aggregate approach. - - Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0); - - TC_Complex, - TC_Complex_Right, - TC_Complex_Left : Complex_Pack.Complex := Complex_Zero; - - TC_Real : Real_Type := 0.0; - - TC_Imaginary : Complex_Pack.Imaginary; - - begin - - - -- Check that the imaginary component of the result of a binary addition - -- operator that yields a result of complex type is exact when either - -- of its operands is of pure-real type. - - TC_Complex := Compose_From_Cartesian(2.0, 3.0); - TC_Real := 3.0; - - if Im("+"(Left => TC_Complex, Right => TC_Real)) /= 3.0 or - Im("+"(TC_Complex, 6.0)) /= 3.0 or - Im(TC_Complex + TC_Real) /= 3.0 or - Im(TC_Complex + 5.0) /= 3.0 or - Im((7.0, 2.0) + 1.0) /= 2.0 or - Im((7.0, 5.0) + (-2.0)) /= 5.0 or - Im((-7.0, -2.0) + 1.0) /= -2.0 or - Im((-7.0, -3.0) + (-3.0)) /= -3.0 - then - Report.Failed("Incorrect results from Function ""+"" with " & - "one Complex and one Real argument - 1"); - end if; - - if Im("+"(Left => TC_Real, Right => TC_Complex)) /= 3.0 or - Im("+"(4.0, TC_Complex)) /= 3.0 or - Im(TC_Real + TC_Complex) /= 3.0 or - Im(9.0 + TC_Complex) /= 3.0 or - Im(1.0 + (7.0, -9.0)) /= -9.0 or - Im((-2.0) + (7.0, 2.0)) /= 2.0 or - Im(1.0 + (-7.0, -5.0)) /= -5.0 or - Im((-3.0) + (-7.0, 16.0)) /= 16.0 - then - Report.Failed("Incorrect results from Function ""+"" with " & - "one Complex and one Real argument - 2"); - end if; - - - -- Check that the imaginary component of the result of a binary - -- subtraction operator that yields a result of complex type is exact - -- when its right operand is of pure-real type. - - TC_Complex := (8.0, -4.0); - TC_Real := 2.0; - - if Im("-"(Left => TC_Complex, Right => TC_Real)) /= -4.0 or - Im("-"(TC_Complex, 5.0)) /= -4.0 or - Im(TC_Complex - TC_Real) /= -4.0 or - Im(TC_Complex - 4.0) /= -4.0 or - Im((6.0, 5.0) - 1.0) /= 5.0 or - Im((6.0, 13.0) - 7.0) /= 13.0 or - Im((-5.0, 3.0) - (2.0)) /= 3.0 or - Im((-5.0, -6.0) - (-3.0)) /= -6.0 - then - Report.Failed("Incorrect results from Function ""-"" with " & - "one Complex and one Real argument"); - end if; - - - -- Check that the real component of the result of a binary addition - -- operator that yields a result of complex type is exact when either - -- of its operands is of pure-imaginary type. - - TC_Complex := (5.0, 0.0); - - if Re("+"(Left => TC_Complex, Right => i)) /= 5.0 or - Re("+"(Complex_Pack.j, TC_Complex)) /= 5.0 or - Re((-8.0, 5.0) + ( 2.0*i)) /= -8.0 or - Re((2.0, 5.0) + (-2.0*i)) /= 2.0 or - Re((-20.0, -5.0) + ( 3.0*i)) /= -20.0 or - Re((6.0, -5.0) + (-3.0*i)) /= 6.0 - then - Report.Failed("Incorrect results from Function ""+"" with " & - "one Complex and one Imaginary argument"); - end if; - - - -- Check that the real component of the result of a binary - -- subtraction operator that yields a result of complex type is exact - -- when its right operand is of pure-imaginary type. - - TC_Complex := TC_Complex + i; -- Should produce (5.0, 1.0) - - if Re("-"(TC_Complex, i)) /= 5.0 or - Re((-4.0, 4.0) - ( 2.0*i)) /= -4.0 or - Re((9.0, 4.0) - ( 5.0*i)) /= 9.0 or - Re((16.0, -5.0) - ( 3.0*i)) /= 16.0 or - Re((-3.0, -5.0) - (-4.0*i)) /= -3.0 - then - Report.Failed("Incorrect results from Function ""-"" with " & - "one Complex and one Imaginary argument"); - end if; - - - -- Check that the result of a binary addition operation is exact when - -- one of its operands is of real type and the other is of - -- pure-imaginary type; the operator is analogous to the - -- Compose_From_Cartesian function; it performs no arithmetic. - - TC_Complex := Complex_Pack."+"(5.0, Complex_Pack.i); - - if TC_Complex /= (5.0, 1.0) or - (4.0 + i) /= (4.0, 1.0) or - "+"(Left => j, Right => 3.0) /= (3.0, 1.0) - then - Report.Failed("Incorrect results from Function ""+"" with " & - "one Real and one Imaginary argument"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXG1002; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a b/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a deleted file mode 100644 index c3885136b86..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a +++ /dev/null @@ -1,478 +0,0 @@ --- CXG1003.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 subprograms defined in the package Text_IO.Complex_IO --- provide correct results. --- --- TEST DESCRIPTION: --- The generic package Ada.Numerics.Generic_Complex_Types is instantiated --- with a real type (new Float). The resulting new package is used as --- the generic actual to package Complex_IO. --- Two different versions of Put and Get are examined in this test, --- those that input/output complex data values from/to Text_IO files, --- and those that input/output complex data values from/to strings. --- Two procedures are defined to perform the file data manipulations; --- one to place complex data into the file, and one to retrieve the data --- from the file and verify its correctness. --- Complex data is also put into string variables using the Procedure --- Put for strings, and this data is then retrieved and reconverted into --- complex values using the Get procedure. --- --- --- APPLICABILITY CRITERIA: --- This test is only applicable to implementations that: --- support Annex G, --- support Text_IO and external files --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 29 Dec 94 SAIC Modified Width parameter in Get function calls. --- 16 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1. --- 29 Sep 96 SAIC Incorporated reviewer comments. --- ---! - -with Ada.Text_IO.Complex_IO; -with Ada.Numerics.Generic_Complex_Types; -with Report; - -procedure CXG1003 is -begin - - Report.Test ("CXG1003", "Check that the subprograms defined in " & - "the package Text_IO.Complex_IO " & - "provide correct results"); - - Test_for_Text_IO_Support: - declare - use Ada; - - Data_File : Ada.Text_IO.File_Type; - Data_Filename : constant String := Report.Legal_File_Name; - - begin - - -- An application creates a text file in mode Out_File, with the - -- intention of entering complex data into the file as appropriate. - -- In the event that the particular environment where the application - -- is running does not support Text_IO, Use_Error or Name_Error will be - -- raised on calls to Text_IO operations. Either of these exceptions - -- will be handled to produce a Not_Applicable result. - - Text_IO.Create (File => Data_File, - Mode => Ada.Text_IO.Out_File, - Name => Data_Filename); - - Test_Block: - declare - - TC_Verbose : Boolean := False; - - type Real_Type is new Float; - - package Complex_Pack is new - Ada.Numerics.Generic_Complex_Types(Real_Type); - - package C_IO is new Ada.Text_IO.Complex_IO(Complex_Pack); - - use Ada.Text_IO, C_IO; - use type Complex_Pack.Complex; - - Number_Of_Complex_Items : constant := 6; - Number_Of_Error_Items : constant := 2; - - TC_Complex : Complex_Pack.Complex; - TC_Last_Character_Read : Positive; - - Complex_Array : array (1..Number_Of_Complex_Items) - of Complex_Pack.Complex := ( (3.0, 9.0), - (4.0, 7.0), - (5.0, 6.0), - (6.0, 3.0), - (2.0, 5.0), - (3.0, 7.0) ); - - - procedure Load_Data_File (The_File : in out Text_IO.File_Type) is - use Ada.Text_IO; - begin - -- This procedure does not create, open, or close the data file; - -- The_File file object must be Open at this point. - -- This procedure is designed to load complex data into a data - -- file twice, first using Text_IO, then Complex_IO. In this - -- first case, the complex data values are entered as strings, - -- assuming a variety of legal formats, as provided in the - -- reference manual. - - Put_Line(The_File, "(3.0, 9.0)"); - Put_Line(The_File, "+4. +7."); -- Relaxed real literal format. - Put_Line(The_File, "(5.0 6.)"); - Put_Line(The_File, "6., 3.0"); - Put_Line(The_File, " ( 2.0 , 5.0 ) "); - Put_Line(The_File, "("); -- Complex data separated over - Put_Line(The_File, "3.0"); -- several (5) lines. - Put_Line(The_File, " , "); - Put_Line(The_File, "7.0 "); - Put_Line(The_File, ")"); - - if TC_Verbose then - Report.Comment("Complex values entered into data file using " & - "Text_IO, Procedure Load_Data_File"); - end if; - - -- Use the Complex_IO procedure Put to enter Complex data items - -- into the data file. - -- Note: Data is being entered into the file for the *second* time - -- at this point. (Using Complex_IO here, Text_IO above) - - for i in 1..Number_Of_Complex_Items loop - C_IO.Put(File => The_File, - Item => Complex_Array(i), - Fore => 1, - Aft => 1, - Exp => 0); - end loop; - - if TC_Verbose then - Report.Comment("Complex values entered into data file using " & - "Complex_IO, Procedure Load_Data_File"); - end if; - - Put_Line(The_File, "(5A,3)"); -- data to raise Data_Error. - Put_Line(The_File, "(3.0,,8.0)"); -- data to raise Data_Error. - - end Load_Data_File; - - - - procedure Process_Data_File (The_File : in out Text_IO.File_Type) is - TC_Complex : Complex_Pack.Complex := (0.0, 0.0); - TC_Width : Integer := 0; - begin - -- This procedure does not create, open, or close the data file; - -- The_File file object must be Open at this point. - -- Use procedure Get (for Files) to extract the complex data from - -- the Text_IO file. This data was placed into the file using - -- Text_IO. - - - for i in 1..Number_Of_Complex_Items loop - - C_IO.Get(The_File, TC_Complex, TC_Width); - - if TC_Complex /= Complex_Array(i) then - Report.Failed("Incorrect complex data read from file " & - "when using Text_IO procedure Get, " & - "data item #" & Integer'Image(i)); - end if; - end loop; - - if TC_Verbose then - Report.Comment("First set of complex values extracted " & - "from data file using Complex_IO, " & - "Procedure Process_Data_File"); - end if; - - -- Use procedure Get (for Files) to extract the complex data from - -- the Text_IO file. This data was placed into the file using - -- procedure Complex_IO.Put. - -- Note: Data is being extracted from the file for the *second* - -- time at this point (Using Complex_IO here, Text_IO above) - - for i in 1..Number_Of_Complex_Items loop - - C_IO.Get(The_File, TC_Complex, TC_Width); - - if TC_Complex /= Complex_Array(i) then - Report.Failed("Incorrect complex data read from file " & - "when using Complex_IO procedure Get, " & - "data item #" & Integer'Image(i)); - end if; - end loop; - - if TC_Verbose then - Report.Comment("Second set of complex values extracted " & - "from data file using Complex_IO, " & - "Procedure Process_Data_File"); - end if; - - -- The final items in the Data_File are complex values with - -- incorrect syntax, which should raise Data_Error on an attempt - -- to read them from the file. - TC_Width := 10; - for i in 1..Number_Of_Error_Items loop - begin - C_IO.Get(The_File, TC_Complex, TC_Width); - Report.Failed - ("Exception Data_Error not raised when Complex_IO.Get " & - "was used to read complex data with incorrect " & - "syntax from the Data_File, data item #" & - Integer'Image(i)); - exception - when Ada.Text_IO.Data_Error => -- OK, expected exception. - Text_IO.Skip_Line(The_File); - when others => - Report.Failed - ("Unexpected exception raised when Complex_IO.Get " & - "was used to read complex data with incorrect " & - "syntax from the Data_File, data item #" & - Integer'Image(i)); - end; - end loop; - - if TC_Verbose then - Report.Comment("Erroneous set of complex values extracted " & - "from data file using Complex_IO, " & - "Procedure Process_Data_File"); - end if; - - - exception - when others => - Report.Failed - ("Unexpected exception raised in Process_Data_File"); - end Process_Data_File; - - - - begin -- Test_Block. - - -- Place complex values into data file. - - Load_Data_File(Data_File); - Text_IO.Close(Data_File); - - if TC_Verbose then - Report.Comment("Data file loaded with Complex values"); - end if; - - -- Read complex values from data file. - - Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename); - Process_Data_File(Data_File); - - if TC_Verbose then - Report.Comment("Complex values extracted from data file"); - end if; - - - - -- Verify versions of Procedures Put and Get for Strings. - - declare - TC_String_Array : array (1..Number_Of_Complex_Items) - of String(1..15) := (others =>(others => ' ')); - begin - - -- Place complex values into strings using the Procedure Put. - - for i in 1..Number_Of_Complex_Items loop - C_IO.Put(To => TC_String_Array(i), - Item => Complex_Array(i), - Aft => 1, - Exp => 0); - end loop; - - if TC_Verbose then - Report.Comment("Complex values placed into string array"); - end if; - - -- Check the format of the strings containing a complex number. - -- The resulting strings are of 15 character length, with the - -- real component left justified within the string, followed by - -- a comma, and with the imaginary component and closing - -- parenthesis right justified in the string, with blank fill - -- for the balance of the string. - - if TC_String_Array(1) /= "(3.0, 9.0)" or - TC_String_Array(2) /= "(4.0, 7.0)" or - TC_String_Array(3) /= "(5.0, 6.0)" or - TC_String_Array(4) /= "(6.0, 3.0)" or - TC_String_Array(5) /= "(2.0, 5.0)" or - TC_String_Array(6) /= "(3.0, 7.0)" - then - Report.Failed("Incorrect format for complex values that " & - "have been placed into string variables " & - "using the Complex_IO.Put procedure for " & - "strings"); - end if; - - if TC_Verbose then - Report.Comment("String format of Complex values verified"); - end if; - - -- Get complex values from strings using the Procedure Get. - -- Compare with expected complex values. - - for i in 1..Number_Of_Complex_Items loop - - C_IO.Get(From => TC_String_Array(i), - Item => TC_Complex, - Last => TC_Last_Character_Read); - - if TC_Complex /= Complex_Array(i) then - Report.Failed("Incorrect complex data value obtained " & - "from String following use of Procedures " & - "Put and Get from Strings, Complex_Array " & - "item #" & Integer'Image(i)); - end if; - end loop; - - if TC_Verbose then - Report.Comment("Complex values removed from String array"); - end if; - - -- Verify that Layout_Error is raised if the given string is - -- too short to hold the formatted output. - Layout_Error_On_Put: - declare - Much_Too_Short : String(1..2); - Complex_Value : Complex_Pack.Complex := (5.0, 0.0); - begin - C_IO.Put(Much_Too_Short, Complex_Value); - Report.Failed("Layout_Error not raised by Procedure Put " & - "when the given string was too short to " & - "hold the formatted output"); - exception - when Layout_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Unexpected exception raised by Procedure Put when " & - "the given string was too short to hold the " & - "formatted output"); - end Layout_Error_On_Put; - - if TC_Verbose then - Report.Comment("Layout Errors verified"); - end if; - - exception - when others => - Report.Failed("Unexpected exception raised during the " & - "evaluation of Put and Get for Strings"); - end; - - - -- Place complex values into strings using a variety of legal - -- complex data formats. - declare - - type String_Ptr is access String; - - TC_Complex_String_Array : - array (1..Number_Of_Complex_Items) of String_Ptr := - (new String'( "(3.0, 9.0 )" ), - new String'( "+4.0 +7.0" ), - new String'( "(5.0 6.0)" ), - new String'( "6.0, 3.0" ), - new String'( " ( 2.0 , 5.0 ) " ), - new String'( "(3.0 7.0)" )); - - -- The following array contains Positive values that correspond - -- to the last character that will be read by Procedure Get when - -- given each of the above strings as input. - - TC_Last_Char_Array : array (1..Number_Of_Complex_Items) - of Positive := (12,10,9,8,20,22); - - begin - - -- Get complex values from strings using the Procedure Get. - -- Compare with expected complex values. - - for i in 1..Number_Of_Complex_Items loop - - C_IO.Get(TC_Complex_String_Array(i).all, - TC_Complex, - TC_Last_Character_Read); - - if TC_Complex /= Complex_Array(i) then - Report.Failed - ("Incorrect complex data value obtained from " & - "Procedure Get with complex data input of: " & - TC_Complex_String_Array(i).all); - end if; - - if TC_Last_Character_Read /= TC_Last_Char_Array(i) then - Report.Failed - ("Incorrect value returned as the last character of " & - "the input string processed by Procedure Get, " & - "string value : " & TC_Complex_String_Array(i).all & - " expected last character value read : " & - Positive'Image(TC_Last_Char_Array(i)) & - " last character value read : " & - Positive'Image(TC_Last_Character_Read)); - end if; - - end loop; - - if TC_Verbose then - Report.Comment("Complex values removed from strings and " & - "verified against expected values"); - end if; - - exception - when others => - Report.Failed("Unexpected exception raised during the " & - "evaluation of Get for Strings"); - end; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - -- Delete the external file. - if Ada.Text_IO.Is_Open(Data_File) then - Ada.Text_IO.Delete(Data_File); - else - Ada.Text_IO.Open(Data_File, - Ada.Text_IO.In_File, - Data_Filename); - Ada.Text_IO.Delete(Data_File); - end if; - - exception - - -- Since Use_Error can be raised if, for the specified mode, - -- the environment does not support Text_IO operations, the - -- following handlers are included: - - when Ada.Text_IO.Use_Error => - Report.Not_Applicable ("Use_Error raised on Text_IO Create"); - - when Ada.Text_IO.Name_Error => - Report.Not_Applicable ("Name_Error raised on Text_IO Create"); - - when others => - Report.Failed ("Unexpected exception raised on text file Create"); - - end Test_for_Text_IO_Support; - - Report.Result; - -end CXG1003; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a b/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a deleted file mode 100644 index f026eae70db..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a +++ /dev/null @@ -1,360 +0,0 @@ --- CXG1004.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 specified exceptions are raised by the subprograms --- defined in package Ada.Numerics.Generic_Complex_Elementary_Functions --- given the prescribed input parameter values. --- --- TEST DESCRIPTION: --- This test checks that specific subprograms defined in the --- package Ada.Numerics.Generic_Complex_Elementary_Functions raise the --- exceptions Argument_Error and Constraint_Error when their input --- parameter value are those specified as causing each exception. --- In the case of Constraint_Error, the exception will be raised in --- each test case, provided that the value of the attribute --- 'Machine_Overflows (for the actual type of package --- Generic_Complex_Type) is True. --- --- APPLICABILITY CRITERIA: --- This test only applies to implementations supporting the --- numerics annex. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 16 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1. --- 29 Sep 96 SAIC Incorporated reviewer comments. --- 02 Jun 98 EDS Replace "_i" with "_One". ---! - -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Generic_Complex_Elementary_Functions; -with Report; - -procedure CXG1004 is -begin - - Report.Test ("CXG1004", "Check that the specified exceptions are " & - "raised by the subprograms defined in package " & - "Ada.Numerics.Generic_Complex_Elementary_" & - "Functions given the prescribed input " & - "parameter values"); - - Test_Block: - declare - - type Real_Type is new Float; - - TC_Overflows : Boolean := Real_Type'Machine_Overflows; - - package Complex_Pack is - new Ada.Numerics.Generic_Complex_Types(Real_Type); - - package CEF is - new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack); - - use Ada.Numerics, Complex_Pack, CEF; - - Complex_Zero : constant Complex := Compose_From_Cartesian(0.0, 0.0); - Plus_One : constant Complex := Compose_From_Cartesian(1.0, 0.0); - Minus_One : constant Complex := Compose_From_Cartesian(-1.0, 0.0); - Plus_i : constant Complex := Compose_From_Cartesian(i); - Minus_i : constant Complex := Compose_From_Cartesian(-i); - - Complex_Negative_Real : constant Complex := - Compose_From_Cartesian(-4.0, 2.0); - Complex_Negative_Imaginary : constant Complex := - Compose_From_Cartesian(3.0, -5.0); - - TC_Complex : Complex; - - - -- This procedure is used in "Exception Raising" calls below in an - -- attempt to avoid elimination of the subtest through optimization. - - procedure No_Optimize (The_Complex_Number : Complex) is - begin - Report.Comment("No Optimize: Should never be printed " & - Integer'Image(Integer(The_Complex_Number.Im))); - end No_Optimize; - - - begin - - -- Check that the exception Numerics.Argument_Error is raised by the - -- exponentiation operator when the value of the left operand is zero, - -- and the real component of the exponent (or the exponent itself) is - -- zero. - - begin - TC_Complex := "**"(Left => Complex_Zero, Right => Complex_Zero); - Report.Failed("Argument_Error not raised by exponentiation " & - "operator, left operand = complex zero, right " & - "operand = complex zero"); - No_Optimize(TC_Complex); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by exponentiation " & - "operator, left operand = complex zero, right " & - "operand = complex zero"); - end; - - begin - TC_Complex := Complex_Zero**0.0; - Report.Failed("Argument_Error not raised by exponentiation " & - "operator, left operand = complex zero, right " & - "operand = real zero"); - No_Optimize(TC_Complex); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by exponentiation " & - "operator, left operand = complex zero, right " & - "operand = real zero"); - end; - - - begin - TC_Complex := "**"(Left => 0.0, Right => Complex_Zero); - Report.Failed("Argument_Error not raised by exponentiation " & - "operator, left operand = real zero, right " & - "operand = complex zero"); - No_Optimize(TC_Complex); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by exponentiation " & - "operator, left operand = real zero, right " & - "operand = complex zero"); - end; - - - -- Check that the exception Constraint_Error is raised under the - -- specified circumstances, provided that - -- Complex_Types.Real'Machine_Overflows is True. - - if TC_Overflows then - - -- Raised by Log, when the value of the parameter X is zero. - begin - TC_Complex := Log (X => Complex_Zero); - Report.Failed("Constraint_Error not raised when Function " & - "Log given parameter value of complex zero"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Log given parameter value of complex zero"); - end; - - -- Raised by Cot, when the value of the parameter X is zero. - begin - TC_Complex := Cot (X => Complex_Zero); - Report.Failed("Constraint_Error not raised when Function " & - "Cot given parameter value of complex zero"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Cot given parameter value of complex zero"); - end; - - -- Raised by Coth, when the value of the parameter X is zero. - begin - TC_Complex := Coth (Complex_Zero); - Report.Failed("Constraint_Error not raised when Function " & - "Coth given parameter value of complex zero"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Coth given parameter value of complex zero"); - end; - - -- Raised by the exponentiation operator, when the value of the - -- left operand is zero and the real component of the exponent - -- is negative. - begin - TC_Complex := Complex_Zero**Complex_Negative_Real; - Report.Failed("Constraint_Error not raised when the " & - "exponentiation operator left operand is " & - "complex zero, and the real component of " & - "the exponent is negative"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when the " & - "exponentiation operator left operand is " & - "complex zero, and the real component of " & - "the exponent is negative"); - end; - - -- Raised by the exponentiation operator, when the value of the - -- left operand is zero and the exponent itself (when it is of - -- type real) is negative. - declare - Negative_Exponent : constant Real_Type := -4.0; - begin - TC_Complex := Complex_Zero**Negative_Exponent; - Report.Failed("Constraint_Error not raised when the " & - "exponentiation operator left operand is " & - "complex zero, and the real exponent is " & - "negative"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when the " & - "exponentiation operator left operand is " & - "complex zero, and the real exponent is " & - "negative"); - end; - - -- Raised by Arctan, when the value of the parameter is +i. - begin - TC_Complex := Arctan (Plus_i); - Report.Failed("Constraint_Error not raised when Function " & - "Arctan is given parameter value +i"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Arctan is given parameter value +i"); - end; - - -- Raised by Arctan, when the value of the parameter is -i. - begin - TC_Complex := Arctan (Minus_i); - Report.Failed("Constraint_Error not raised when Function " & - "Arctan is given parameter value -i"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Arctan is given parameter value -i"); - end; - - -- Raised by Arccot, when the value of the parameter is +i. - begin - TC_Complex := Arccot (Plus_i); - Report.Failed("Constraint_Error not raised when Function " & - "Arccot is given parameter value +i"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Arccot is given parameter value +i"); - end; - - -- Raised by Arccot, when the value of the parameter is -i. - begin - TC_Complex := Arccot (Minus_i); - Report.Failed("Constraint_Error not raised when Function " & - "Arccot is given parameter value -i"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Arccot is given parameter value -i"); - end; - - -- Raised by Arctanh, when the value of the parameter is +1. - begin - TC_Complex := Arctanh (Plus_One); - Report.Failed("Constraint_Error not raised when Function " & - "Arctanh is given parameter value +1"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Arctanh is given parameter value +1"); - end; - - -- Raised by Arctanh, when the value of the parameter is -1. - begin - TC_Complex := Arctanh (Minus_One); - Report.Failed("Constraint_Error not raised when Function " & - "Arctanh is given parameter value -1"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Arctanh is given parameter value -1"); - end; - - -- Raised by Arccoth, when the value of the parameter is +1. - begin - TC_Complex := Arccoth (Plus_One); - Report.Failed("Constraint_Error not raised when Function " & - "Arccoth is given parameter value +1"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Arccoth is given parameter value +1"); - end; - - -- Raised by Arccoth, when the value of the parameter is -1. - begin - TC_Complex := Arccoth (Minus_One); - Report.Failed("Constraint_Error not raised when Function " & - "Arccoth is given parameter value -1"); - No_Optimize(TC_Complex); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised when Function " & - "Arccoth is given parameter value -1"); - end; - - else - Report.Comment - ("Attribute Complex_Pack.Real'Machine_Overflows is False; " & - "evaluation of the complex elementary functions under " & - "specified circumstances was not performed"); - end if; - - - exception - when others => - Report.Failed ("Unexpected exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXG1004; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a b/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a deleted file mode 100644 index 6faad4e1357..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a +++ /dev/null @@ -1,393 +0,0 @@ --- CXG1005.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 subprograms defined in the package --- Ada.Numerics.Generic_Complex_Elementary_Functions provide correct --- results. --- --- TEST DESCRIPTION: --- This test checks that specific subprograms defined in the generic --- package Generic_Complex_Elementary_Functions are available, and that --- they provide prescribed results given specific input values. --- The generic package Ada.Numerics.Generic_Complex_Types is instantiated --- with a real type (new Float). The resulting new package is used as --- the generic actual to package Complex_IO. --- --- SPECIAL REQUIREMENTS: --- Implementations for which Float'Signed_Zeros is True must provide --- a body for ImpDef.Annex_G.Negative_Zero which returns a negative --- zero. --- --- APPLICABILITY CRITERIA --- This test only applies to implementations that support the --- numerics annex. --- --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 16 Nov 95 SAIC Corrected visibility problems for ACVC 2.0.1. --- 21 Feb 96 SAIC Incorporated new structure for package Impdef. --- 29 Sep 96 SAIC Incorporated reviewer comments. --- ---! - -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Generic_Complex_Elementary_Functions; -with ImpDef.Annex_G; -with Report; - -procedure CXG1005 is -begin - - Report.Test ("CXG1005", "Check that the subprograms defined in " & - "the package Generic_Complex_Elementary_" & - "Functions provide correct results"); - - Test_Block: - declare - - type Real_Type is new Float; - - TC_Signed_Zeros : Boolean := Real_Type'Signed_Zeros; - - package Complex_Pack is new - Ada.Numerics.Generic_Complex_Types(Real_Type); - - package CEF is - new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack); - - use Ada.Numerics, Complex_Pack, CEF; - - Complex_Zero : constant Complex := Compose_From_Cartesian( 0.0, 0.0); - Plus_One : constant Complex := Compose_From_Cartesian( 1.0, 0.0); - Minus_One : constant Complex := Compose_From_Cartesian(-1.0, 0.0); - Plus_i : constant Complex := Compose_From_Cartesian(i); - Minus_i : constant Complex := Compose_From_Cartesian(-i); - - Complex_Positive_Real : constant Complex := - Compose_From_Cartesian(4.0, 2.0); - Complex_Positive_Imaginary : constant Complex := - Compose_From_Cartesian(3.0, 5.0); - Complex_Negative_Real : constant Complex := - Compose_From_Cartesian(-4.0, 2.0); - Complex_Negative_Imaginary : constant Complex := - Compose_From_Cartesian(3.0, -5.0); - - - function A_Zero_Result (Z : Complex) return Boolean is - begin - return (Re(Z) = 0.0 and Im(Z) = 0.0); - end A_Zero_Result; - - - -- In order to evaluate complex elementary functions that are - -- prescribed to return a "real" result (meaning that the imaginary - -- component is zero), the Function A_Real_Result is defined. - - function A_Real_Result (Z : Complex) return Boolean is - begin - return Im(Z) = 0.0; - end A_Real_Result; - - - -- In order to evaluate complex elementary functions that are - -- prescribed to return an "imaginary" result (meaning that the real - -- component of the complex number is zero, and the imaginary - -- component is non-zero), the Function An_Imaginary_Result is defined. - - function An_Imaginary_Result (Z : Complex) return Boolean is - begin - return (Re(Z) = 0.0 and Im(Z) /= 0.0); - end An_Imaginary_Result; - - - begin - - -- Check that when the input parameter value is zero, the following - -- functions yield a zero result. - - if not A_Zero_Result( Sqrt(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Sqrt with zero input"); - end if; - - if not A_Zero_Result( Sin(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Sin with zero input"); - end if; - - if not A_Zero_Result( Arcsin(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Arcsin with zero " & - "input"); - end if; - - if not A_Zero_Result( Tan(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Tan with zero input"); - end if; - - if not A_Zero_Result( Arctan(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Arctan with zero " & - "input"); - end if; - - if not A_Zero_Result( Sinh(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Sinh with zero input"); - end if; - - if not A_Zero_Result( Arcsinh(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Arcsinh with zero " & - "input"); - end if; - - if not A_Zero_Result( Tanh(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Tanh with zero input"); - end if; - - if not A_Zero_Result( Arctanh(Complex_Zero) ) then - Report.Failed("Non-zero result from Function Arctanh with zero " & - "input"); - end if; - - - -- Check that when the input parameter value is zero, the following - -- functions yield a result of one. - - if Exp(Complex_Zero) /= Plus_One - then - Report.Failed("Non-zero result from Function Exp with zero input"); - end if; - - if Cos(Complex_Zero) /= Plus_One - then - Report.Failed("Non-zero result from Function Cos with zero input"); - end if; - - if Cosh(Complex_Zero) /= Plus_One - then - Report.Failed("Non-zero result from Function Cosh with zero input"); - end if; - - - -- Check that when the input parameter value is zero, the following - -- functions yield a real result. - - if not A_Real_Result( Arccos(Complex_Zero) ) then - Report.Failed("Non-real result from Function Arccos with zero input"); - end if; - - if not A_Real_Result( Arccot(Complex_Zero) ) then - Report.Failed("Non-real result from Function Arccot with zero input"); - end if; - - - -- Check that when the input parameter value is zero, the following - -- functions yield an imaginary result. - - if not An_Imaginary_Result( Arccoth(Complex_Zero) ) then - Report.Failed("Non-imaginary result from Function Arccoth with " & - "zero input"); - end if; - - - -- Check that when the input parameter value is one, the Sqrt function - -- yields a result of one. - - if Sqrt(Plus_One) /= Plus_One then - Report.Failed("Incorrect result from Function Sqrt with input " & - "value of one"); - end if; - - - -- Check that when the input parameter value is one, the following - -- functions yield a result of zero. - - if not A_Zero_Result( Log(Plus_One) ) then - Report.Failed("Non-zero result from Function Log with input " & - "value of one"); - end if; - - if not A_Zero_Result( Arccos(Plus_One) ) then - Report.Failed("Non-zero result from Function Arccos with input " & - "value of one"); - end if; - - if not A_Zero_Result( Arccosh(Plus_One) ) then - Report.Failed("Non-zero result from Function Arccosh with input " & - "value of one"); - end if; - - - -- Check that when the input parameter value is one, the Arcsin - -- function yields a real result. - - if not A_Real_Result( Arcsin(Plus_One) ) then - Report.Failed("Non-real result from Function Arcsin with input " & - "value of one"); - end if; - - - -- Check that when the input parameter value is minus one, the Sqrt - -- function yields a result of "i", when the sign of the imaginary - -- component of the input parameter is positive (and yields "-i", if - -- the sign on the imaginary component is negative), and the - -- Complex_Types.Real'Signed_Zeros attribute is True. - - if TC_Signed_Zeros then - - declare - Minus_One_With_Pos_Zero_Im_Component : Complex := - Compose_From_Cartesian(-1.0, +0.0); - Minus_One_With_Neg_Zero_Im_Component : Complex := - Compose_From_Cartesian - (-1.0, Real_Type(ImpDef.Annex_G.Negative_Zero)); - begin - - if Sqrt(Minus_One_With_Pos_Zero_Im_Component) /= Plus_i then - Report.Failed("Incorrect result from Function Sqrt, when " & - "input value is minus one with a positive " & - "imaginary component, Signed_Zeros being True"); - end if; - - if Sqrt(Minus_One_With_Neg_Zero_Im_Component) /= Minus_i then - Report.Failed("Incorrect result from Function Sqrt, when " & - "input value is minus one with a negative " & - "imaginary component, Signed_Zeros being True"); - end if; - end; - - else -- Signed_Zeros is False. - - -- Check that when the input parameter value is minus one, the Sqrt - -- function yields a result of "i", when the - -- Complex_Types.Real'Signed_Zeros attribute is False. - - if Sqrt(Minus_One) /= Plus_i then - Report.Failed("Incorrect result from Function Sqrt, when " & - "input value is minus one, Signed_Zeros being " & - "False"); - end if; - - end if; - - - -- Check that when the input parameter value is minus one, the Log - -- function yields an imaginary result. - - if not An_Imaginary_Result( Log(Minus_One) ) then - Report.Failed("Non-imaginary result from Function Log with a " & - "minus one input value"); - end if; - - -- Check that when the input parameter is minus one, the following - -- functions yield a real result. - - if not A_Real_Result( Arcsin(Minus_One) ) then - Report.Failed("Non-real result from Function Arcsin with a " & - "minus one input value"); - end if; - - if not A_Real_Result( Arccos(Minus_One) ) then - Report.Failed("Non-real result from Function Arccos with a " & - "minus one input value"); - end if; - - - -- Check that when the input parameter has a value of +i or -i, the - -- Log function yields an imaginary result. - - if not An_Imaginary_Result( Log(Plus_i) ) then - Report.Failed("Non-imaginary result from Function Log with an " & - "input value of ""+i"""); - end if; - - if not An_Imaginary_Result( Log(Minus_i) ) then - Report.Failed("Non-imaginary result from Function Log with an " & - "input value of ""-i"""); - end if; - - - -- Check that exponentiation by a zero exponent yields the value one. - - if "**"(Left => Compose_From_Cartesian(5.0, 3.0), - Right => Complex_Zero) /= Plus_One or - Complex_Negative_Real**0.0 /= Plus_One or - 15.0**Complex_Zero /= Plus_One - then - Report.Failed("Incorrect result from exponentiation with a zero " & - "exponent"); - end if; - - - -- Check that exponentiation by a unit exponent yields the value of - -- the left operand (as a complex value). - -- Note: a "unit exponent" is considered the complex number (1.0, 0.0) - - if "**"(Complex_Negative_Real, Plus_One) /= - Complex_Negative_Real or - Complex_Negative_Imaginary**Plus_One /= - Complex_Negative_Imaginary or - 4.0**Plus_One /= - Compose_From_Cartesian(4.0, 0.0) - then - Report.Failed("Incorrect result from exponentiation with a unit " & - "exponent"); - end if; - - - -- Check that exponentiation of the value one yields the value one. - - if "**"(Plus_One, Complex_Negative_Imaginary) /= Plus_One or - Plus_One**9.0 /= Plus_One or - 1.0**Complex_Negative_Real /= Plus_One - then - Report.Failed("Incorrect result from exponentiation of the value " & - "One"); - end if; - - - -- Check that exponentiation of the value zero yields the value zero. - begin - if not A_Zero_Result("**"(Complex_Zero, - Complex_Positive_Imaginary)) or - not A_Zero_Result(Complex_Zero**4.0) or - not A_Zero_Result(0.0**Complex_Positive_Real) - then - Report.Failed("Incorrect result from exponentiation of the " & - "value zero"); - end if; - exception - when others => - Report.Failed("Exception raised during the exponentiation of " & - "the complex value zero"); - end; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXG1005; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a deleted file mode 100644 index 0d7afa46091..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a +++ /dev/null @@ -1,322 +0,0 @@ --- CXG2001.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 floating point attributes Model_Mantissa, --- Machine_Mantissa, Machine_Radix, and Machine_Rounds --- are properly reported. --- --- TEST DESCRIPTION: --- This test uses a generic package to compute and check the --- values of the Machine_ attributes listed above. The --- generic package is instantiated with the standard FLOAT --- type and a floating point type for the maximum number --- of digits of precision. --- --- APPLICABILITY CRITERIA: --- This test applies only to implementations supporting the --- Numerics Annex. --- --- --- CHANGE HISTORY: --- 26 JAN 96 SAIC Initial Release for 2.1 --- ---! - --- References: --- --- "Algorithms To Reveal Properties of Floating-Point Arithmetic" --- Michael A. Malcolm; CACM November 1972; pgs 949-951. --- --- Software Manual for Elementary Functions; W. J. Cody and W. Waite; --- Prentice-Hall; 1980 ------------------------------------------------------------------------ --- --- This test relies upon the fact that --- (A+2.0)-A is not necessarily 2.0. If A is large enough then adding --- a small value to A does not change the value of A. Consider the case --- where we have a decimal based floating point representation with 4 --- digits of precision. A floating point number would logically be --- represented as "DDDD * 10 ** exp" where D is a value in the range 0..9. --- The first loop of the test starts A at 2.0 and doubles it until --- ((A+1.0)-A)-1.0 is no longer zero. For our decimal floating point --- number this will be 1638 * 10**1 (the value 16384 rounded or truncated --- to fit in 4 digits). --- The second loop starts B at 2.0 and keeps doubling B until (A+B)-A is --- no longer 0. This will keep looping until B is 8.0 because that is --- the first value where rounding (assuming our machine rounds and addition --- employs a guard digit) will change the upper 4 digits of the result: --- 1638_ --- + 8 --- ------- --- 1639_ --- Without rounding the second loop will continue until --- B is 16: --- 1638_ --- + 16 --- ------- --- 1639_ --- --- The radix is then determined by (A+B)-A which will give 10. --- --- The use of Tmp and ITmp in the test is to force values to be --- stored into memory in the event that register precision is greater --- than the stored precision of the floating point values. --- --- --- The test for rounding is (ignoring the temporary variables used to --- get the stored precision) is --- Rounds := A + Radix/2.0 - A /= 0.0 ; --- where A is the value determined in the first step that is the smallest --- power of 2 such that A + 1.0 = A. This means that the true value of --- A has one more digit in its value than 'Machine_Mantissa. --- This check will detect the case where a value is always rounded. --- There is an additional case where values are rounded to the nearest --- even value. That is referred to as IEEE style rounding in the test. --- ------------------------------------------------------------------------ - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -procedure CXG2001 is - Verbose : constant Boolean := False; - - -- if one of the attribute computation loops exceeds Max_Iterations - -- it is most likely due to the compiler reordering an expression - -- that should not be reordered. - Illegal_Optimization : exception; - Max_Iterations : constant := 10_000; - - generic - type Real is digits <>; - package Chk_Attrs is - procedure Do_Test; - end Chk_Attrs; - - package body Chk_Attrs is - package EF is new Ada.Numerics.Generic_Elementary_Functions (Real); - function Log (X : Real) return Real renames EF.Log; - - - -- names used in paper - Radix : Integer; -- Beta - Mantissa_Digits : Integer; -- t - Rounds : Boolean; -- RND - - -- made global to Determine_Attributes to help thwart optimization - A, B : Real := 2.0; - Tmp, Tmpa, Tmp1 : Real; - ITmp : Integer; - Half_Radix : Real; - - -- special constants - not declared as constants so that - -- the "stored" precision will be used instead of a "register" - -- precision. - Zero : Real := 0.0; - One : Real := 1.0; - Two : Real := 2.0; - - - procedure Thwart_Optimization is - -- the purpose of this procedure is to reference the - -- global variables used by Determine_Attributes so - -- that the compiler is not likely to keep them in - -- a higher precision register for their entire lifetime. - begin - if Report.Ident_Bool (False) then - -- never executed - A := A + 5.0; - B := B + 6.0; - Tmp := Tmp + 1.0; - Tmp1 := Tmp1 + 2.0; - Tmpa := Tmpa + 2.0; - One := 12.34; Two := 56.78; Zero := 90.12; - end if; - end Thwart_Optimization; - - - -- determines values for Radix, Mantissa_Digits, and Rounds - -- This is mostly a straight translation of the C code. - -- The only significant addition is the iteration count - -- to prevent endless looping if things are really screwed up. - procedure Determine_Attributes is - Iterations : Integer; - begin - Rounds := True; - - Iterations := 0; - Tmp := Real'Machine (((A + One) - A) - One); - while Tmp = Zero loop - A := Real'Machine(A + A); - Tmp := Real'Machine(A + One); - Tmp1 := Real'Machine(Tmp - A); - Tmp := Real'Machine(Tmp1 - One); - - Iterations := Iterations + 1; - if Iterations > Max_Iterations then - raise Illegal_Optimization; - end if; - end loop; - - Iterations := 0; - Tmp := Real'Machine(A + B); - ITmp := Integer (Tmp - A); - while ITmp = 0 loop - B := Real'Machine(B + B); - Tmp := Real'Machine(A + B); - ITmp := Integer (Tmp - A); - - Iterations := Iterations + 1; - if Iterations > Max_Iterations then - raise Illegal_Optimization; - end if; - end loop; - - Radix := ITmp; - - Mantissa_Digits := 0; - B := 1.0; - Tmp := Real'Machine(((B + One) - B) - One); - Iterations := 0; - while (Tmp = Zero) loop - Mantissa_Digits := Mantissa_Digits + 1; - B := B * Real (Radix); - Tmp := Real'Machine(B + One); - Tmp1 := Real'Machine(Tmp - B); - Tmp := Real'Machine(Tmp1 - One); - - Iterations := Iterations + 1; - if Iterations > Max_Iterations then - raise Illegal_Optimization; - end if; - end loop; - - Rounds := False; - Half_Radix := Real (Radix) / Two; - Tmp := Real'Machine(A + Half_Radix); - Tmp1 := Real'Machine(Tmp - A); - if (Tmp1 /= Zero) then - Rounds := True; - end if; - Tmpa := Real'Machine(A + Real (Radix)); - Tmp := Real'Machine(Tmpa + Half_Radix); - if not Rounds and (Tmp - TmpA /= Zero) then - Rounds := True; - if Verbose then - Report.Comment ("IEEE style rounding"); - end if; - end if; - - exception - when others => - Thwart_Optimization; - raise; - end Determine_Attributes; - - - procedure Do_Test is - Show_Results : Boolean := Verbose; - Min_Mantissa_Digits : Integer; - begin - -- compute the actual Machine_* attribute values - Determine_Attributes; - - if Real'Machine_Radix /= Radix then - Report.Failed ("'Machine_Radix incorrectly reports" & - Integer'Image (Real'Machine_Radix)); - Show_Results := True; - end if; - - if Real'Machine_Mantissa /= Mantissa_Digits then - Report.Failed ("'Machine_Mantissa incorrectly reports" & - Integer'Image (Real'Machine_Mantissa)); - Show_Results := True; - end if; - - if Real'Machine_Rounds /= Rounds then - Report.Failed ("'Machine_Rounds incorrectly reports " & - Boolean'Image (Real'Machine_Rounds)); - Show_Results := True; - end if; - - if Show_Results then - Report.Comment ("computed Machine_Mantissa is" & - Integer'Image (Mantissa_Digits)); - Report.Comment ("computed Radix is" & - Integer'Image (Radix)); - Report.Comment ("computed Rounds is " & - Boolean'Image (Rounds)); - end if; - - -- check the model attributes against the machine attributes - -- G.2.2(3)/3;6.0 - if Real'Model_Mantissa > Real'Machine_Mantissa then - Report.Failed ("model mantissa > machine mantissa"); - end if; - - -- G.2.2(3)/2;6.0 - -- 'Model_Mantissa >= ceiling(d*log(10)/log(radix))+1 - Min_Mantissa_Digits := - Integer ( - Real'Ceiling ( - Real(Real'Digits) * Log(10.0) / Log(Real(Real'Machine_Radix)) - ) ) + 1; - if Real'Model_Mantissa < Min_Mantissa_Digits then - Report.Failed ("Model_Mantissa [" & - Integer'Image (Real'Model_Mantissa) & - "] < minimum mantissa digits [" & - Integer'Image (Min_Mantissa_Digits) & - "]"); - end if; - - exception - when Illegal_Optimization => - Report.Failed ("illegal optimization of" & - " floating point expression"); - end Do_Test; - end Chk_Attrs; - - package Chk_Float is new Chk_Attrs (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package Chk_A_Long_Float is new Chk_Attrs (A_Long_Float); -begin - Report.Test ("CXG2001", - "Check the attributes Model_Mantissa," & - " Machine_Mantissa, Machine_Radix," & - " and Machine_Rounds"); - - Report.Comment ("checking Standard.Float"); - Chk_Float.Do_Test; - - Report.Comment ("checking a digits" & - Integer'Image (System.Max_Digits) & - " floating point type"); - Chk_A_Long_Float.Do_Test; - - Report.Result; -end CXG2001; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a deleted file mode 100644 index 6a1f322e8bf..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a +++ /dev/null @@ -1,468 +0,0 @@ --- CXG2002.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 complex "abs" or modulus function returns --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test uses a generic package to compute and check the --- values of the modulus function. In addition, a non-generic --- copy of this package is used to check the non-generic package --- Ada.Numerics.Complex_Types. --- Of special interest is the case where either the real or --- the imaginary part of the argument is very large while the --- other part is very small or 0. --- We want to check that the value is computed such that --- an overflow does not occur. If computed directly from the --- definition --- abs (x+yi) = sqrt(x**2 + y**2) --- then overflow or underflow is much more likely than if the --- argument is normalized first. --- --- 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: --- 31 JAN 96 SAIC Initial release for 2.1 --- 02 JUN 98 EDS Add parens to intermediate calculations. ---! - --- --- Reference: --- Problems and Methodologies in Mathematical Software Production; --- editors: P. C. Messina and A Murli; --- Lecture Notes in Computer Science --- Volume 142 --- Springer Verlag 1982 --- - -with System; -with Report; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Complex_Types; -procedure CXG2002 is - Verbose : constant Boolean := False; - Maximum_Relative_Error : constant := 3.0; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Complex_Types is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Types; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real := Maximum_Relative_Error) is - Rel_Error, - Abs_Error, - 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 & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Expected - Actual) & - " max_err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Do_Test is - Z : Complex; - X : Real; - T : Real; - begin - - --- test 1 --- - begin - T := Real'Safe_Last; - Z := T + 0.0*i; - X := abs Z; - Check (X, T, "test 1 -- abs(bigreal + 0i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - begin - T := Real'Safe_Last; - Z := 0.0 + T*i; - X := Modulus (Z); - Check (X, T, "test 2 -- abs(0 + bigreal*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - begin - Z := 3.0 + 4.0*i; - X := abs Z; - Check (X, 5.0 , "test 3 -- abs(3 + 4*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - S : Real; - begin - S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3); - Z := 3.0 * S + 4.0*S*i; - X := abs Z; - Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S", - 5.0*Real'Model_Epsilon); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - - --- test 5 --- - begin - T := Real'Model_Small; - Z := T + 0.0*i; - X := abs Z; - Check (X, T , "test 5 -- abs(small + 0*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 5"); - when others => - Report.Failed ("exception in test 5"); - end; - - --- test 6 --- - begin - T := Real'Model_Small; - Z := 0.0 + T*i; - X := abs Z; - Check (X, T , "test 6 -- abs(0 + small*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 6"); - when others => - Report.Failed ("exception in test 6"); - end; - - --- test 7 --- - declare - S : Real; - begin - S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3); - Z := 3.0 * S + 4.0*S*i; - X := abs Z; - Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S", - 5.0*Real'Model_Epsilon); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 7"); - when others => - Report.Failed ("exception in test 7"); - end; - - --- test 8 --- - declare - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - begin - Z := 1.0 + 1.0*i; - X := abs Z; - Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 8"); - when others => - Report.Failed ("exception in test 8"); - end; - - --- test 9 --- - begin - T := 0.0; - Z := T + 0.0*i; - X := abs Z; - Check (X, T , "test 5 -- abs(0 + 0*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 9"); - when others => - Report.Failed ("exception in test 9"); - end; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - --- non generic copy of the above generic package - ----------------------------------------------------------------------- - - package Non_Generic_Check is - subtype Real is Float; - procedure Do_Test; - end Non_Generic_Check; - - package body Non_Generic_Check is - use Ada.Numerics.Complex_Types; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real := Maximum_Relative_Error) is - Rel_Error, - Abs_Error, - 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 & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Expected - Actual) & - " max_err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Do_Test is - Z : Complex; - X : Real; - T : Real; - begin - - --- test 1 --- - begin - T := Real'Safe_Last; - Z := T + 0.0*i; - X := abs Z; - Check (X, T, "test 1 -- abs(bigreal + 0i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - begin - T := Real'Safe_Last; - Z := 0.0 + T*i; - X := Modulus (Z); - Check (X, T, "test 2 -- abs(0 + bigreal*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - begin - Z := 3.0 + 4.0*i; - X := abs Z; - Check (X, 5.0 , "test 3 -- abs(3 + 4*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - S : Real; - begin - S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3); - Z := 3.0 * S + 4.0*S*i; - X := abs Z; - Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S", - 5.0*Real'Model_Epsilon); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - - --- test 5 --- - begin - T := Real'Model_Small; - Z := T + 0.0*i; - X := abs Z; - Check (X, T , "test 5 -- abs(small + 0*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 5"); - when others => - Report.Failed ("exception in test 5"); - end; - - --- test 6 --- - begin - T := Real'Model_Small; - Z := 0.0 + T*i; - X := abs Z; - Check (X, T , "test 6 -- abs(0 + small*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 6"); - when others => - Report.Failed ("exception in test 6"); - end; - - --- test 7 --- - declare - S : Real; - begin - S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3); - Z := 3.0 * S + 4.0*S*i; - X := abs Z; - Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S", - 5.0*Real'Model_Epsilon); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 7"); - when others => - Report.Failed ("exception in test 7"); - end; - - --- test 8 --- - declare - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - begin - Z := 1.0 + 1.0*i; - X := abs Z; - Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 8"); - when others => - Report.Failed ("exception in test 8"); - end; - - --- test 9 --- - begin - T := 0.0; - Z := T + 0.0*i; - X := abs Z; - Check (X, T , "test 5 -- abs(0 + 0*i)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 9"); - when others => - Report.Failed ("exception in test 9"); - end; - end Do_Test; - end Non_Generic_Check; - - ----------------------------------------------------------------------- - --- end of "manual instantiation" - ----------------------------------------------------------------------- - package Chk_Float is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package Chk_A_Long_Float is new Generic_Check (A_Long_Float); -begin - Report.Test ("CXG2002", - "Check the accuracy of the complex modulus" & - " function"); - - if Verbose then - Report.Comment ("checking Standard.Float"); - end if; - Chk_Float.Do_Test; - - if Verbose then - Report.Comment ("checking a digits" & - Integer'Image (System.Max_Digits) & - " floating point type"); - end if; - Chk_A_Long_Float.Do_Test; - - if Verbose then - Report.Comment ("checking non-generic package"); - end if; - Non_Generic_Check.Do_Test; - Report.Result; -end CXG2002; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a deleted file mode 100644 index d1a225a50a1..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a +++ /dev/null @@ -1,701 +0,0 @@ --- CXG2003.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 sqrt function returns --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test contains three test packages that are almost --- identical. The first two packages differ only in the --- floating point type that is being tested. The first --- and third package differ only in whether the generic --- elementary functions package or the pre-instantiated --- package is used. --- The test package is not generic so that the arguments --- and expected results for some of the test values --- can be expressed as universal real instead of being --- computed at runtime. --- --- 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: --- 2 FEB 96 SAIC Initial release for 2.1 --- 18 AUG 96 SAIC Made Check consistent with other tests. --- ---! - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -with Ada.Numerics.Elementary_Functions; -procedure CXG2003 is - Verbose : constant Boolean := False; - - package Float_Check is - subtype Real is Float; - procedure Do_Test; - end Float_Check; - - package body Float_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real) return Real renames - Elementary_Functions.Sqrt; - function Log (X : Real) return Real renames - Elementary_Functions.Log; - function Exp (X : Real) return Real renames - Elementary_Functions.Exp; - - -- The default Maximum Relative Error is the value specified - -- in the LRM. - Default_MRE : constant Real := 2.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real := Default_MRE) 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 & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Actual - Expected) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Argument_Range_Check (A, B : Real; - Test : String) is - -- test a logarithmically distributed selection of - -- arguments selected from the range A to B. - X : Real; - Expected : Real; - Y : Real; - C : Real := Log(B/A); - Max_Samples : constant := 1000; - - begin - for I in 1..Max_Samples loop - Expected := A * Exp(C * Real (I) / Real (Max_Samples)); - X := Expected * Expected; - Y := Sqrt (X); - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (Y, Expected, - "test " & Test & " -" & - Integer'Image (I) & - " of argument range", - 3.0); - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check"); - when others => - Report.Failed ("exception in argument range check"); - end Argument_Range_Check; - - procedure Do_Test is - begin - - --- test 1 --- - declare - T : constant := (Real'Machine_EMax - 1) / 2; - X : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - Expected : constant := (1.0 * Real'Machine_Radix) ** T; - Y : Real; - begin - Y := Sqrt (X); - Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - T : constant := (Real'Model_EMin + 1) / 2; - X : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - Expected : constant := (1.0 * Real'Machine_Radix) ** T; - Y : Real; - begin - Y := Sqrt (X); - Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - X : constant := 1.0; - Expected : constant := 1.0; - Y : Real; - begin - Y := Sqrt(X); - Check (Y, Expected, "test 3 -- sqrt(1.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - X : constant := 0.0; - Expected : constant := 0.0; - Y : Real; - begin - Y := Sqrt(X); - Check (Y, Expected, "test 4 -- sqrt(0.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - - --- test 5 --- - declare - X : constant := -1.0; - Y : Real; - begin - Y := Sqrt(X); - -- the following code should not be executed. - -- The call to Check is to keep the call to Sqrt from - -- appearing to be dead code. - Check (Y, -1.0, "test 5 -- sqrt(-1)" ); - Report.Failed ("test 5 - argument_error expected"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 5"); - when Ada.Numerics.Argument_Error => - if Verbose then - Report.Comment ("test 5 correctly got argument_error"); - end if; - when others => - Report.Failed ("exception in test 5"); - end; - - --- test 6 --- - declare - X : constant := Ada.Numerics.Pi ** 2; - Expected : constant := Ada.Numerics.Pi; - Y : Real; - begin - Y := Sqrt (X); - Check (Y, Expected, "test 6 -- sqrt(pi**2)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 6"); - when others => - Report.Failed ("exception in test 6"); - end; - - --- test 7 & 8 --- - Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)), - 1.0, - "7"); - Argument_Range_Check (1.0, - Sqrt(Real(Real'Machine_Radix)), - "8"); - end Do_Test; - end Float_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - - - package A_Long_Float_Check is - subtype Real is A_Long_Float; - procedure Do_Test; - end A_Long_Float_Check; - - package body A_Long_Float_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real) return Real renames - Elementary_Functions.Sqrt; - function Log (X : Real) return Real renames - Elementary_Functions.Log; - function Exp (X : Real) return Real renames - Elementary_Functions.Exp; - - -- The default Maximum Relative Error is the value specified - -- in the LRM. - Default_MRE : constant Real := 2.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real := Default_MRE) 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 & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Actual - Expected) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Argument_Range_Check (A, B : Real; - Test : String) is - -- test a logarithmically distributed selection of - -- arguments selected from the range A to B. - X : Real; - Expected : Real; - Y : Real; - C : Real := Log(B/A); - Max_Samples : constant := 1000; - - begin - for I in 1..Max_Samples loop - Expected := A * Exp(C * Real (I) / Real (Max_Samples)); - X := Expected * Expected; - Y := Sqrt (X); - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (Y, Expected, - "test " & Test & " -" & - Integer'Image (I) & - " of argument range", - 3.0); - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check"); - when others => - Report.Failed ("exception in argument range check"); - end Argument_Range_Check; - - - procedure Do_Test is - begin - - --- test 1 --- - declare - T : constant := (Real'Machine_EMax - 1) / 2; - X : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - Expected : constant := (1.0 * Real'Machine_Radix) ** T; - Y : Real; - begin - Y := Sqrt (X); - Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - T : constant := (Real'Model_EMin + 1) / 2; - X : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - Expected : constant := (1.0 * Real'Machine_Radix) ** T; - Y : Real; - begin - Y := Sqrt (X); - Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - X : constant := 1.0; - Expected : constant := 1.0; - Y : Real; - begin - Y := Sqrt(X); - Check (Y, Expected, "test 3 -- sqrt(1.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - X : constant := 0.0; - Expected : constant := 0.0; - Y : Real; - begin - Y := Sqrt(X); - Check (Y, Expected, "test 4 -- sqrt(0.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - - --- test 5 --- - declare - X : constant := -1.0; - Y : Real; - begin - Y := Sqrt(X); - -- the following code should not be executed. - -- The call to Check is to keep the call to Sqrt from - -- appearing to be dead code. - Check (Y, -1.0, "test 5 -- sqrt(-1)" ); - Report.Failed ("test 5 - argument_error expected"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 5"); - when Ada.Numerics.Argument_Error => - if Verbose then - Report.Comment ("test 5 correctly got argument_error"); - end if; - when others => - Report.Failed ("exception in test 5"); - end; - - --- test 6 --- - declare - X : constant := Ada.Numerics.Pi ** 2; - Expected : constant := Ada.Numerics.Pi; - Y : Real; - begin - Y := Sqrt (X); - Check (Y, Expected, "test 6 -- sqrt(pi**2)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 6"); - when others => - Report.Failed ("exception in test 6"); - end; - - --- test 7 & 8 --- - Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)), - 1.0, - "7"); - Argument_Range_Check (1.0, - Sqrt(Real(Real'Machine_Radix)), - "8"); - end Do_Test; - end A_Long_Float_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - package Non_Generic_Check is - procedure Do_Test; - end Non_Generic_Check; - - package body Non_Generic_Check is - package EF renames - Ada.Numerics.Elementary_Functions; - subtype Real is Float; - - -- The default Maximum Relative Error is the value specified - -- in the LRM. - Default_MRE : constant Real := 2.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real := Default_MRE) 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 & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Actual - Expected) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - - procedure Argument_Range_Check (A, B : Float; - Test : String) is - -- test a logarithmically distributed selection of - -- arguments selected from the range A to B. - X : Float; - Expected : Float; - Y : Float; - C : Float := EF.Log(B/A); - Max_Samples : constant := 1000; - - begin - for I in 1..Max_Samples loop - Expected := A * EF.Exp(C * Float (I) / Float (Max_Samples)); - X := Expected * Expected; - Y := EF.Sqrt (X); - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (Y, Expected, - "test " & Test & " -" & - Integer'Image (I) & - " of argument range", - 3.0); - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check"); - when others => - Report.Failed ("exception in argument range check"); - end Argument_Range_Check; - - - procedure Do_Test is - begin - - --- test 1 --- - declare - T : constant := (Float'Machine_EMax - 1) / 2; - X : constant := (1.0 * Float'Machine_Radix) ** (2 * T); - Expected : constant := (1.0 * Float'Machine_Radix) ** T; - Y : Float; - begin - Y := EF.Sqrt (X); - Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - T : constant := (Float'Model_EMin + 1) / 2; - X : constant := (1.0 * Float'Machine_Radix) ** (2 * T); - Expected : constant := (1.0 * Float'Machine_Radix) ** T; - Y : Float; - begin - Y := EF.Sqrt (X); - Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - X : constant := 1.0; - Expected : constant := 1.0; - Y : Float; - begin - Y := EF.Sqrt(X); - Check (Y, Expected, "test 3 -- sqrt(1.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - X : constant := 0.0; - Expected : constant := 0.0; - Y : Float; - begin - Y := EF.Sqrt(X); - Check (Y, Expected, "test 4 -- sqrt(0.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - - --- test 5 --- - declare - X : constant := -1.0; - Y : Float; - begin - Y := EF.Sqrt(X); - -- the following code should not be executed. - -- The call to Check is to keep the call to Sqrt from - -- appearing to be dead code. - Check (Y, -1.0, "test 5 -- sqrt(-1)" ); - Report.Failed ("test 5 - argument_error expected"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 5"); - when Ada.Numerics.Argument_Error => - if Verbose then - Report.Comment ("test 5 correctly got argument_error"); - end if; - when others => - Report.Failed ("exception in test 5"); - end; - - --- test 6 --- - declare - X : constant := Ada.Numerics.Pi ** 2; - Expected : constant := Ada.Numerics.Pi; - Y : Float; - begin - Y := EF.Sqrt (X); - Check (Y, Expected, "test 6 -- sqrt(pi**2)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 6"); - when others => - Report.Failed ("exception in test 6"); - end; - - --- test 7 & 8 --- - Argument_Range_Check (1.0/EF.Sqrt(Float(Float'Machine_Radix)), - 1.0, - "7"); - Argument_Range_Check (1.0, - EF.Sqrt(Float(Float'Machine_Radix)), - "8"); - end Do_Test; - end Non_Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - -begin - Report.Test ("CXG2003", - "Check the accuracy of the sqrt function"); - - 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; - - if Verbose then - Report.Comment ("checking non-generic package"); - end if; - - Non_Generic_Check.Do_Test; - - Report.Result; -end CXG2003; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a deleted file mode 100644 index 2df296d3d42..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a +++ /dev/null @@ -1,499 +0,0 @@ --- CXG2004.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 sin and cos functions return --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check both float and a long float type. --- The test for each floating point type is divided into --- the following parts: --- Special value checks where the result is a known constant. --- Checks using an identity relationship. --- --- 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: --- 13 FEB 96 SAIC Initial release for 2.1 --- 22 APR 96 SAIC Changed to generic implementation. --- 18 AUG 96 SAIC Improvements to commentary. --- 23 OCT 96 SAIC Exact results are not required unless the --- cycle is specified. --- 28 FEB 97 PWB.CTA Removed checks where cycle 2.0*Pi is specified --- 02 JUN 98 EDS Revised calculations to ensure that X is exactly --- three times Y per advice of numerics experts. --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- --- The sin and cos checks are translated directly from --- the netlib FORTRAN code that was written by W. Cody. --- - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -with Ada.Numerics.Elementary_Functions; -procedure CXG2004 is - Verbose : constant Boolean := False; - Number_Samples : constant := 1000; - - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; - - Pi : constant := Ada.Numerics.Pi; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - - function Sin (X : Real) return Real renames - Elementary_Functions.Sin; - function Cos (X : Real) return Real renames - Elementary_Functions.Cos; - function Sin (X, Cycle : Real) return Real renames - Elementary_Functions.Sin; - function Cos (X, Cycle : Real) return Real renames - Elementary_Functions.Cos; - - Accuracy_Error_Reported : Boolean := False; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Rel_Error, - Abs_Error, - 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; - - - -- in addition to the relative error checks we apply the - -- criteria of G.2.4(16) - if abs (Actual) > 1.0 then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & " result > 1.0"); - elsif abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Actual - Expected) & - " mre:" & - Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Sin_Check (A, B : Real; - Arg_Range : String) is - -- test a selection of - -- arguments selected from the range A to B. - -- - -- This test uses the identity - -- sin(x) = sin(x/3)*(3 - 4 * sin(x/3)**2) - -- - -- Note that in this test we must take into account the - -- error in the calculation of the expected result so - -- the maximum relative error is larger than the - -- accuracy required by the ARM. - - X, Y, ZZ : Real; - Actual, Expected : Real; - MRE : Real; - Ran : Real; - begin - Accuracy_Error_Reported := False; -- reset - for I in 1 .. Number_Samples loop - -- Evenly distributed selection of arguments - Ran := Real (I) / Real (Number_Samples); - - -- make sure x and x/3 are both exactly representable - -- on the machine. See "Implementation and Testing of - -- Function Software" page 44. - X := (B - A) * Ran + A; - Y := Real'Leading_Part - ( X/3.0, - Real'Machine_Mantissa - Real'Exponent (3.0) ); - X := Y * 3.0; - - Actual := Sin (X); - - ZZ := Sin(Y); - Expected := ZZ * (3.0 - 4.0 * ZZ * ZZ); - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - -- See Cody pp 139-141. - MRE := 4.0; - - Check (Actual, Expected, - "sin test of range" & Arg_Range & - Integer'Image (I), - MRE); - exit when Accuracy_Error_Reported; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in sin check"); - when others => - Report.Failed ("exception in sin check"); - end Sin_Check; - - - - procedure Cos_Check (A, B : Real; - Arg_Range : String) is - -- test a selection of - -- arguments selected from the range A to B. - -- - -- This test uses the identity - -- cos(x) = cos(x/3)*(4 * cos(x/3)**2 - 3) - -- - -- Note that in this test we must take into account the - -- error in the calculation of the expected result so - -- the maximum relative error is larger than the - -- accuracy required by the ARM. - - X, Y, ZZ : Real; - Actual, Expected : Real; - MRE : Real; - Ran : Real; - begin - Accuracy_Error_Reported := False; -- reset - for I in 1 .. Number_Samples loop - -- Evenly distributed selection of arguments - Ran := Real (I) / Real (Number_Samples); - - -- make sure x and x/3 are both exactly representable - -- on the machine. See "Implementation and Testing of - -- Function Software" page 44. - X := (B - A) * Ran + A; - Y := Real'Leading_Part - ( X/3.0, - Real'Machine_Mantissa - Real'Exponent (3.0) ); - X := Y * 3.0; - - Actual := Cos (X); - - ZZ := Cos(Y); - Expected := ZZ * (4.0 * ZZ * ZZ - 3.0); - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - -- See Cody pp 141-143. - MRE := 6.0; - - Check (Actual, Expected, - "cos test of range" & Arg_Range & - Integer'Image (I), - MRE); - exit when Accuracy_Error_Reported; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in cos check"); - when others => - Report.Failed ("exception in cos check"); - end Cos_Check; - - - procedure Special_Angle_Checks is - type Data_Point is - record - Degrees, - Radians, - Sine, - Cosine : Real; - Sin_Result_Error, - Cos_Result_Error : Boolean; - end record; - - type Test_Data_Type is array (Positive range <>) of Data_Point; - - -- the values in the following table only involve static - -- expressions to minimize any loss of precision. However, - -- there are two sources of error that must be accounted for - -- in the following tests. - -- First, when a cycle is not specified there can be a roundoff - -- error in the value of Pi used. This error does not apply - -- when a cycle of 2.0 * Pi is explicitly provided. - -- Second, the expected results that involve sqrt values also - -- have a potential roundoff error. - -- The amount of error due to error in the argument is computed - -- as follows: - -- sin(x+err) = sin(x)*cos(err) + cos(x)*sin(err) - -- ~= sin(x) + err * cos(x) - -- similarly for cos the error due to error in the argument is - -- computed as follows: - -- cos(x+err) = cos(x)*cos(err) - sin(x)*sin(err) - -- ~= cos(x) - err * sin(x) - -- In both cases the term "err" is bounded by 0.5 * argument. - - Test_Data : constant Test_Data_Type := ( --- degrees radians sine cosine sin_er cos_er test # - ( 0.0, 0.0, 0.0, 1.0, False, False ), -- 1 - ( 30.0, Pi/6.0, 0.5, Sqrt3/2.0, False, True ), -- 2 - ( 60.0, Pi/3.0, Sqrt3/2.0, 0.5, True, False ), -- 3 - ( 90.0, Pi/2.0, 1.0, 0.0, False, False ), -- 4 - (120.0, 2.0*Pi/3.0, Sqrt3/2.0, -0.5, True, False ), -- 5 - (150.0, 5.0*Pi/6.0, 0.5, -Sqrt3/2.0, False, True ), -- 6 - (180.0, Pi, 0.0, -1.0, False, False ), -- 7 - (210.0, 7.0*Pi/6.0, -0.5, -Sqrt3/2.0, False, True ), -- 8 - (240.0, 8.0*Pi/6.0, -Sqrt3/2.0, -0.5, True, False ), -- 9 - (270.0, 9.0*Pi/6.0, -1.0, 0.0, False, False ), -- 10 - (300.0, 10.0*Pi/6.0, -Sqrt3/2.0, 0.5, True, False ), -- 11 - (330.0, 11.0*Pi/6.0, -0.5, Sqrt3/2.0, False, True ), -- 12 - (360.0, 2.0*Pi, 0.0, 1.0, False, False ), -- 13 - ( 45.0, Pi/4.0, Sqrt2/2.0, Sqrt2/2.0, True, True ), -- 14 - (135.0, 3.0*Pi/4.0, Sqrt2/2.0, -Sqrt2/2.0, True, True ), -- 15 - (225.0, 5.0*Pi/4.0, -Sqrt2/2.0, -Sqrt2/2.0, True, True ), -- 16 - (315.0, 7.0*Pi/4.0, -Sqrt2/2.0, Sqrt2/2.0, True, True ), -- 17 - (405.0, 9.0*Pi/4.0, Sqrt2/2.0, Sqrt2/2.0, True, True ) ); -- 18 - - - Y : Real; - Sin_Arg_Err, - Cos_Arg_Err, - Sin_Result_Err, - Cos_Result_Err : Real; - begin - for I in Test_Data'Range loop - -- compute error components - Sin_Arg_Err := abs Test_Data (I).Cosine * - abs Test_Data (I).Radians / 2.0; - Cos_Arg_Err := abs Test_Data (I).Sine * - abs Test_Data (I).Radians / 2.0; - - if Test_Data (I).Sin_Result_Error then - Sin_Result_Err := 0.5; - else - Sin_Result_Err := 0.0; - end if; - - if Test_Data (I).Cos_Result_Error then - Cos_Result_Err := 1.0; - else - Cos_Result_Err := 0.0; - end if; - - - - Y := Sin (Test_Data (I).Radians); - Check (Y, Test_Data (I).Sine, - "test" & Integer'Image (I) & " sin(r)", - 2.0 + Sin_Arg_Err + Sin_Result_Err); - Y := Cos (Test_Data (I).Radians); - Check (Y, Test_Data (I).Cosine, - "test" & Integer'Image (I) & " cos(r)", - 2.0 + Cos_Arg_Err + Cos_Result_Err); - Y := Sin (Test_Data (I).Degrees, 360.0); - Check (Y, Test_Data (I).Sine, - "test" & Integer'Image (I) & " sin(d,360)", - 2.0 + Sin_Result_Err); - Y := Cos (Test_Data (I).Degrees, 360.0); - Check (Y, Test_Data (I).Cosine, - "test" & Integer'Image (I) & " cos(d,360)", - 2.0 + Cos_Result_Err); ---pwb-math Y := Sin (Test_Data (I).Radians, 2.0*Pi); ---pwb-math Check (Y, Test_Data (I).Sine, ---pwb-math "test" & Integer'Image (I) & " sin(r,2pi)", ---pwb-math 2.0 + Sin_Result_Err); ---pwb-math Y := Cos (Test_Data (I).Radians, 2.0*Pi); ---pwb-math Check (Y, Test_Data (I).Cosine, ---pwb-math "test" & Integer'Image (I) & " cos(r,2pi)", ---pwb-math 2.0 + Cos_Result_Err); - end loop; - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special angle test"); - when others => - Report.Failed ("exception in special angle test"); - end Special_Angle_Checks; - - - -- check the rule of A.5.1(41);6.0 which requires that the - -- result be exact if the mathematical result is 0.0, 1.0, - -- or -1.0 - procedure Exact_Result_Checks is - type Data_Point is - record - Degrees, - Sine, - Cosine : Real; - end record; - - type Test_Data_Type is array (Positive range <>) of Data_Point; - Test_Data : constant Test_Data_Type := ( - -- degrees sine cosine test # - ( 0.0, 0.0, 1.0 ), -- 1 - ( 90.0, 1.0, 0.0 ), -- 2 - (180.0, 0.0, -1.0 ), -- 3 - (270.0, -1.0, 0.0 ), -- 4 - (360.0, 0.0, 1.0 ), -- 5 - ( 90.0 + 360.0, 1.0, 0.0 ), -- 6 - (180.0 + 360.0, 0.0, -1.0 ), -- 7 - (270.0 + 360.0,-1.0, 0.0 ), -- 8 - (360.0 + 360.0, 0.0, 1.0 ) ); -- 9 - - Y : Real; - begin - for I in Test_Data'Range loop - Y := Sin (Test_Data(I).Degrees, 360.0); - if Y /= Test_Data(I).Sine then - Report.Failed ("exact result for sin(" & - Real'Image (Test_Data(I).Degrees) & - ", 360.0) is not" & - Real'Image (Test_Data(I).Sine) & - " Difference is " & - Real'Image (Y - Test_Data(I).Sine) ); - end if; - - Y := Cos (Test_Data(I).Degrees, 360.0); - if Y /= Test_Data(I).Cosine then - Report.Failed ("exact result for cos(" & - Real'Image (Test_Data(I).Degrees) & - ", 360.0) is not" & - Real'Image (Test_Data(I).Cosine) & - " Difference is " & - Real'Image (Y - Test_Data(I).Cosine) ); - end if; - end loop; - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in exact result check"); - when others => - Report.Failed ("exception in exact result check"); - end Exact_Result_Checks; - - - procedure Do_Test is - begin - Special_Angle_Checks; - Sin_Check (0.0, Pi/2.0, "0..pi/2"); - Sin_Check (6.0*Pi, 6.5*Pi, "6pi..6.5pi"); - Cos_Check (7.0*Pi, 7.5*Pi, "7pi..7.5pi"); - Exact_Result_Checks; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2004", - "Check the accuracy of the sin and cos 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 CXG2004; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a deleted file mode 100644 index 4054b83d88a..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a +++ /dev/null @@ -1,204 +0,0 @@ --- CXG2005.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 floating point addition and multiplication --- have the required accuracy. --- --- TEST DESCRIPTION: --- The check for the required precision is essentially a --- check that a guard digit is used for the operations. --- This test uses a generic package to check the addition --- and multiplication results. The --- generic package is instantiated with the standard FLOAT --- type and a floating point type for the maximum number --- of digits of precision. --- --- APPLICABILITY CRITERIA: --- This test applies only to implementations supporting the --- Numerics Annex. --- --- --- CHANGE HISTORY: --- 14 FEB 96 SAIC Initial Release for 2.1 --- 16 SEP 99 RLB Repaired to avoid printing thousands of (almost) --- identical failure messages. ---! - --- References: --- --- Basic Concepts for Computational Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Vol 142 --- Springer Verlag, 1982 --- --- Software Manual for the Elementary Functions --- William J. Cody and William Waite --- Prentice-Hall, 1980 --- - -with System; -with Report; -procedure CXG2005 is - Verbose : constant Boolean := False; - - generic - type Real is digits <>; - package Guard_Digit_Check is - procedure Do_Test; - end Guard_Digit_Check; - - package body Guard_Digit_Check is - -- made global so that the compiler will be more likely - -- to keep the values in memory instead of in higher - -- precision registers. - X, Y, Z : Real; - OneX : Real; - Eps, BN : Real; - - -- special constants - not declared as constants so that - -- the "stored" precision will be used instead of a "register" - -- precision. - Zero : Real := 0.0; - One : Real := 1.0; - Two : Real := 2.0; - - Failure_Count : Natural := 0; - - procedure Thwart_Optimization is - -- the purpose of this procedure is to reference the - -- global variables used by the test so - -- that the compiler is not likely to keep them in - -- a higher precision register for their entire lifetime. - begin - if Report.Ident_Bool (False) then - -- never executed - X := X + 5.0; - Y := Y + 6.0; - Z := Z + 1.0; - Eps := Eps + 2.0; - BN := BN + 2.0; - OneX := X + Y; - One := 12.34; Two := 56.78; Zero := 90.12; - end if; - end Thwart_Optimization; - - - procedure Addition_Test is - begin - for K in 1..10 loop - Eps := Real (K) * Real'Model_Epsilon; - for N in 1.. Real'Machine_EMax - 1 loop - BN := Real(Real'Machine_Radix) ** N; - X := (One + Eps) * BN; - Y := (One - Eps) * BN; - Z := X - Y; -- true value for Z is 2*Eps*BN - - if Z /= Eps*BN + Eps*BN then - Report.Failed ("addition check failed. K=" & - Integer'Image (K) & - " N=" & Integer'Image (N) & - " difference=" & Real'Image (Z - 2.0*Eps*BN) & - " Eps*BN=" & Real'Image (Eps*BN) ); - Failure_Count := Failure_Count + 1; - exit when Failure_Count > K*4; -- Avoid displaying dozens of messages. - end if; - end loop; - end loop; - exception - when others => - Thwart_Optimization; - Report.Failed ("unexpected exception in addition test"); - end Addition_Test; - - - procedure Multiplication_Test is - begin - X := Real (Real'Machine_Radix) ** (Real'Machine_EMax - 1); - OneX := One * X; - Thwart_Optimization; - if OneX /= X then - Report.Failed ("multiplication for large values"); - end if; - - X := Real (Real'Machine_Radix) ** (Real'Model_EMin + 1); - OneX := One * X; - Thwart_Optimization; - if OneX /= X then - Report.Failed ("multiplication for small values"); - end if; - - -- selection of "random" values between 1/radix and radix - Y := One / Real (Real'Machine_Radix); - Z := Real(Real'Machine_Radix) - One/Real(Real'Machine_Radix); - for I in 0..100 loop - X := Y + Real (I) / 100.0 * Z; - OneX := One * X; - Thwart_Optimization; - if OneX /= X then - Report.Failed ("multiplication for case" & Integer'Image (I)); - exit when Failure_Count > 40+8; -- Avoid displaying dozens of messages. - end if; - end loop; - exception - when others => - Thwart_Optimization; - Report.Failed ("unexpected exception in multiplication test"); - end Multiplication_Test; - - - procedure Do_Test is - begin - Addition_Test; - Multiplication_Test; - end Do_Test; - end Guard_Digit_Check; - - package Chk_Float is new Guard_Digit_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package Chk_A_Long_Float is new Guard_Digit_Check (A_Long_Float); -begin - Report.Test ("CXG2005", - "Check the accuracy of floating point" & - " addition and multiplication"); - - if Verbose then - Report.Comment ("checking Standard.Float"); - end if; - Chk_Float.Do_Test; - - if Verbose then - Report.Comment ("checking a digits" & - Integer'Image (System.Max_Digits) & - " floating point type"); - end if; - Chk_A_Long_Float.Do_Test; - - Report.Result; -end CXG2005; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a deleted file mode 100644 index da15dc3be67..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a +++ /dev/null @@ -1,281 +0,0 @@ --- CXG2006.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 complex Argument function returns --- results that are within the error bound allowed. --- Check that Argument_Error is raised if the Cycle parameter --- is less than or equal to zero. --- --- TEST DESCRIPTION: --- This test uses a generic package to compute and check the --- values of the Argument function. --- Of special interest is the case where either the real or --- the imaginary part of the parameter is very large while the --- other part is very small or 0. --- --- 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: --- 15 FEB 96 SAIC Initial release for 2.1 --- 03 MAR 97 PWB.CTA Removed checks involving explicit cycle => 2.0*Pi --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - --- --- Reference: --- Problems and Methodologies in Mathematical Software Production; --- editors: P. C. Messina and A Murli; --- Lecture Notes in Computer Science --- Volume 142 --- Springer Verlag 1982 --- - -with System; -with Report; -with ImpDef.Annex_G; -with Ada.Numerics; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Complex_Types; -procedure CXG2006 is - Verbose : constant Boolean := False; - - - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; - - Pi : constant := Ada.Numerics.Pi; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Complex_Types is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Types; - - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) 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 & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & - Real'Image (Actual - Expected) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Special_Cases is - type Data_Point is - record - Re, - Im, - Radians, - Degrees, - Error_Bound : Real; - end record; - - type Test_Data_Type is array (Positive range <>) of Data_Point; - - -- the values in the following table only involve static - -- expressions to minimize errors in precision introduced by the - -- test. For cases where Pi is used in the argument we must - -- allow an extra 1.0*MRE to account for roundoff error in the - -- argument. Where the result involves a square root we allow - -- an extra 0.5*MRE to allow for roundoff error. - Test_Data : constant Test_Data_Type := ( --- Re Im Radians Degrees Err Test # - (0.0, 0.0, 0.0, 0.0, 4.0 ), -- 1 - (1.0, 0.0, 0.0, 0.0, 4.0 ), -- 2 - (Real'Safe_Last, 0.0, 0.0, 0.0, 4.0 ), -- 3 - (Real'Model_Small, 0.0, 0.0, 0.0, 4.0 ), -- 4 - (1.0, 1.0, Pi/4.0, 45.0, 5.0 ), -- 5 - (1.0, -1.0, -Pi/4.0, -45.0, 5.0 ), -- 6 - (-1.0, -1.0, -3.0*Pi/4.0,-135.0, 5.0 ), -- 7 - (-1.0, 1.0, 3.0*Pi/4.0, 135.0, 5.0 ), -- 8 - (Sqrt3, 1.0, Pi/6.0, 30.0, 5.5 ), -- 9 - (-Sqrt3, 1.0, 5.0*Pi/6.0, 150.0, 5.5 ), -- 10 - (Sqrt3, -1.0, -Pi/6.0, -30.0, 5.5 ), -- 11 - (-Sqrt3, -1.0, -5.0*Pi/6.0,-150.0, 5.5 ), -- 12 - (Real'Model_Small, Real'Model_Small, Pi/4.0, 45.0, 5.0 ), -- 13 - (-Real'Safe_Last, 0.0, Pi, 180.0, 5.0 ), -- 14 - (-Real'Safe_Last, -Real'Model_Small, -Pi,-180.0, 5.0 ), -- 15 - (100000.0, 100000.0, Pi/4.0, 45.0, 5.0 )); -- 16 - - X : Real; - Z : Complex; - begin - for I in Test_Data'Range loop - begin - Z := (Test_Data(I).Re, Test_Data(I).Im); - X := Argument (Z); - Check (X, Test_Data(I).Radians, - "test" & Integer'Image (I) & " argument(z)", - Test_Data (I).Error_Bound); ---pwb-math X := Argument (Z, 2.0*Pi); ---pwb-math Check (X, Test_Data(I).Radians, ---pwb-math "test" & Integer'Image (I) & " argument(z, 2pi)", ---pwb-math Test_Data (I).Error_Bound); - X := Argument (Z, 360.0); - Check (X, Test_Data(I).Degrees, - "test" & Integer'Image (I) & " argument(z, 360)", - Test_Data (I).Error_Bound); - - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test" & - Integer'Image (I)); - when others => - Report.Failed ("exception in test" & - Integer'Image (I)); - end; - end loop; - - if Real'Signed_Zeros then - begin - X := Argument ((-1.0, Real(ImpDef.Annex_G.Negative_Zero))); - Check (X, -Pi, "test of arg((-1,-0)", 4.0); - exception - when others => - Report.Failed ("exception in signed zero test"); - end; - end if; - end Special_Cases; - - - procedure Exception_Cases is - -- check that Argument_Error is raised if Cycle is <= 0 - Z : Complex := (1.0, 1.0); - X : Real; - Y : Real; - begin - begin - X := Argument (Z, Cycle => 0.0); - Report.Failed ("no exception for cycle = 0.0"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for cycle = 0.0"); - end; - - begin - Y := Argument (Z, Cycle => -3.0); - Report.Failed ("no exception for cycle < 0.0"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for cycle < 0.0"); - end; - - if Report.Ident_Int (2) = 1 then - -- optimization thwarting code - never executed - Report.Failed("2=1" & Real'Image (X+Y)); - end if; - end Exception_Cases; - - - procedure Do_Test is - begin - Special_Cases; - Exception_Cases; - end Do_Test; - end Generic_Check; - - package Chk_Float is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package Chk_A_Long_Float is new Generic_Check (A_Long_Float); -begin - Report.Test ("CXG2006", - "Check the accuracy of the complex argument" & - " function"); - - if Verbose then - Report.Comment ("checking Standard.Float"); - end if; - - Chk_Float.Do_Test; - - if Verbose then - Report.Comment ("checking a digits" & - Integer'Image (System.Max_Digits) & - " floating point type"); - end if; - - Chk_A_Long_Float.Do_Test; - - Report.Result; -end CXG2006; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a deleted file mode 100644 index ba07df29d52..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a +++ /dev/null @@ -1,291 +0,0 @@ --- CXG2007.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 complex Compose_From_Polar function returns --- results that are within the error bound allowed. --- Check that Argument_Error is raised if the Cycle parameter --- is less than or equal to zero. --- --- TEST DESCRIPTION: --- This test uses a generic package to compute and check the --- values of the Compose_From_Polar function. --- --- 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: --- 23 FEB 96 SAIC Initial release for 2.1 --- 23 APR 96 SAIC Fixed error checking --- 03 MAR 97 PWB.CTA Deleted checks with explicit Cycle => 2.0*Pi --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - -with System; -with Report; -with Ada.Numerics; -with Ada.Numerics.Generic_Complex_Types; -procedure CXG2007 is - Verbose : constant Boolean := False; - - - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; - - Pi : constant := Ada.Numerics.Pi; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Complex_Types is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Types; - - Maximum_Relative_Error : constant Real := 3.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real; - Arg_Error : Real) is - -- Arg_Error is additional absolute error that is allowed beyond - -- the MRE to account for error in the result that can be - -- attributed to error in the arguments. - Max_Error : Real; - Rel_Error : Real; - Abs_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_Small 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; - Max_Error := Max_Error + Arg_Error; - - if abs (Actual - Expected) > Max_Error then - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Check (Actual, Expected : Complex; - Test_Name : String; - MRE : Real; - Arg_Error : Real) is - -- Arg_Error is additional absolute error that is allowed beyond - -- the MRE to account for error in the result that can be - -- attributed to error in the arguments. - begin - Check (Actual.Re, Expected.Re, - Test_Name & " real part", - MRE, Arg_Error); - Check (Actual.Im, Expected.Im, - Test_Name & " imaginary part", - MRE, Arg_Error); - end Check; - - - procedure Special_Cases is - type Data_Point is - record - Re, - Im, - Modulus, - Radians, - Degrees, - Arg_Error : Real; - end record; - - -- shorthand names for various constants - P4 : constant := Pi/4.0; - P6 : constant := Pi/6.0; - - MER2 : constant Real := Real'Model_Epsilon * Sqrt2; - - type Test_Data_Type is array (Positive range <>) of Data_Point; - - -- the values in the following table only involve static - -- expressions so no loss of precision occurs. - Test_Data : constant Test_Data_Type := ( - --Re Im Modulus Radians Degrees Arg_Err - ( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ), -- 1 - ( 0.0, 0.0, 0.0, Pi, 180.0, 0.0 ), -- 2 - - ( 1.0, 0.0, 1.0, 0.0, 0.0, 0.0 ), -- 3 - (-1.0, 0.0, -1.0, 0.0, 0.0, 0.0 ), -- 4 - - ( 1.0, 1.0, Sqrt2, P4, 45.0, MER2), -- 5 - (-1.0, 1.0, -Sqrt2, -P4, -45.0, MER2), -- 6 - ( 1.0, -1.0, Sqrt2, -P4, -45.0, MER2), -- 7 - (-1.0, -1.0, -Sqrt2, P4, 45.0, MER2), -- 8 - (-1.0, -1.0, Sqrt2, -3.0*P4,-135.0, MER2), -- 9 - (-1.0, 1.0, Sqrt2, 3.0*P4, 135.0, MER2), -- 10 - ( 1.0, -1.0, -Sqrt2, 3.0*P4, 135.0, MER2), -- 11 - - (-1.0, 0.0, 1.0, Pi, 180.0, 0.0 ), -- 12 - ( 1.0, 0.0, -1.0, Pi, 180.0, 0.0 ) ); -- 13 - - - Z : Complex; - Exp : Complex; - begin - for I in Test_Data'Range loop - begin - Exp := (Test_Data (I).Re, Test_Data (I).Im); - - Z := Compose_From_Polar (Test_Data (I).Modulus, - Test_Data (I).Radians); - Check (Z, Exp, - "test" & Integer'Image (I) & " compose_from_polar(m,r)", - Maximum_Relative_Error, Test_Data (I).Arg_Error); - ---pwb-math Z := Compose_From_Polar (Test_Data (I).Modulus, ---pwb-math Test_Data (I).Radians, ---pwb-math 2.0*Pi); ---pwb-math Check (Z, Exp, ---pwb-math "test" & Integer'Image (I) & " compose_from_polar(m,r,2pi)", ---pwb-math Maximum_Relative_Error, Test_Data (I).Arg_Error); - - Z := Compose_From_Polar (Test_Data (I).Modulus, - Test_Data (I).Degrees, - 360.0); - Check (Z, Exp, - "test" & Integer'Image (I) & " compose_from_polar(m,d,360)", - Maximum_Relative_Error, Test_Data (I).Arg_Error); - - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test" & - Integer'Image (I)); - when others => - Report.Failed ("exception in test" & - Integer'Image (I)); - end; - end loop; - end Special_Cases; - - - procedure Exception_Cases is - -- check that Argument_Error is raised if Cycle is <= 0 - Z : Complex; - W : Complex; - begin - begin - Z := Compose_From_Polar (3.0, 0.0, Cycle => 0.0); - Report.Failed ("no exception for cycle = 0.0"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for cycle = 0.0"); - end; - - begin - W := Compose_From_Polar (6.0, 1.0, Cycle => -10.0); - Report.Failed ("no exception for cycle < 0.0"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for cycle < 0.0"); - end; - - if Report.Ident_Int (1) = 2 then - -- not executed - used to make it appear that we use the - -- results of the above computation - Z := Z * W; - Report.Failed(Real'Image (Z.Re + Z.Im)); - end if; - end Exception_Cases; - - - procedure Do_Test is - begin - Special_Cases; - Exception_Cases; - end Do_Test; - end Generic_Check; - - package Chk_Float is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package Chk_A_Long_Float is new Generic_Check (A_Long_Float); -begin - Report.Test ("CXG2007", - "Check the accuracy of the Compose_From_Polar" & - " function"); - - if Verbose then - Report.Comment ("checking Standard.Float"); - end if; - Chk_Float.Do_Test; - - if Verbose then - Report.Comment ("checking a digits" & - Integer'Image (System.Max_Digits) & - " floating point type"); - end if; - Chk_A_Long_Float.Do_Test; - - Report.Result; -end CXG2007; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a deleted file mode 100644 index 58cf367f61c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a +++ /dev/null @@ -1,948 +0,0 @@ --- CXG2008.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 complex multiplication and division --- operations return results that are within the allowed --- error bound. --- Check that all the required pure Numerics packages are pure. --- --- TEST DESCRIPTION: --- This test contains three test packages that are almost --- identical. The first two packages differ only in the --- floating point type that is being tested. The first --- and third package differ only in whether the generic --- complex types package or the pre-instantiated --- package is used. --- The test package is not generic so that the arguments --- and expected results for some of the test values --- can be expressed as universal real instead of being --- computed at runtime. --- --- 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: --- 24 FEB 96 SAIC Initial release for 2.1 --- 03 JUN 98 EDS Correct the test program's incorrect assumption --- that Constraint_Error must be raised by complex --- division by zero, which is contrary to the --- allowance given by the Ada 95 standard G.1.1(40). --- 13 MAR 01 RLB Replaced commented out Pure check on non-generic --- packages, as required by Defect Report --- 8652/0020 and as reflected in Technical --- Corrigendum 1. ---! - ------------------------------------------------------------------------------- --- Check that the required pure packages are pure by withing them from a --- pure package. The non-generic versions of those packages are required to --- be pure by Defect Report 8652/0020, Technical Corrigendum 1 [A.5.1(9/1) and --- G.1.1(25/1)]. -with Ada.Numerics.Generic_Elementary_Functions; -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Complex_Types; -with Ada.Numerics.Generic_Complex_Elementary_Functions; -with Ada.Numerics.Complex_Elementary_Functions; -package CXG2008_0 is - pragma Pure; - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; -end CXG2008_0; - ------------------------------------------------------------------------------- - -with System; -with Report; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Complex_Types; -with CXG2008_0; use CXG2008_0; -procedure CXG2008 is - Verbose : constant Boolean := False; - - package Float_Check is - subtype Real is Float; - procedure Do_Test; - end Float_Check; - - package body Float_Check is - package Complex_Types is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Types; - - -- keep track if an accuracy failure has occurred so the test - -- can be short-circuited to avoid thousands of error messages. - Failure_Detected : Boolean := False; - - Mult_MBE : constant Real := 5.0; - Divide_MBE : constant Real := 13.0; - - - procedure Check (Actual, Expected : Complex; - Test_Name : String; - MBE : Real) 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 := MBE * abs Expected.Re * Real'Model_Epsilon; - Abs_Error := MBE * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - - if abs (Actual.Re - Expected.Re) > Max_Error then - Failure_Detected := True; - Report.Failed (Test_Name & - " actual.re: " & Real'Image (Actual.Re) & - " expected.re: " & Real'Image (Expected.Re) & - " difference.re " & - Real'Image (Actual.Re - Expected.Re) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result for real part"); - else - Report.Comment (Test_Name & " passed for real part"); - end if; - end if; - - Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - if abs (Actual.Im - Expected.Im) > Max_Error then - Failure_Detected := True; - Report.Failed (Test_Name & - " actual.im: " & Real'Image (Actual.Im) & - " expected.im: " & Real'Image (Expected.Im) & - " difference.im " & - Real'Image (Actual.Im - Expected.Im) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result for imaginary part"); - else - Report.Comment (Test_Name & " passed for imaginary part"); - end if; - end if; - end Check; - - - procedure Special_Values is - begin - - --- test 1 --- - declare - T : constant := (Real'Machine_EMax - 1) / 2; - Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - Expected : Complex := (0.0, 0.0); - X : Complex := (0.0, 0.0); - Y : Complex := (Big, Big); - Z : Complex; - begin - Z := X * Y; - Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)", - Mult_MBE); - Z := Y * X; - Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - T : constant := Real'Model_EMin + 1; - Tiny : constant := (1.0 * Real'Machine_Radix) ** T; - U : Complex := (Tiny, Tiny); - X : Complex := (0.0, 0.0); - Expected : Complex := (0.0, 0.0); - Z : Complex; - begin - Z := U * X; - Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - T : constant := (Real'Machine_EMax - 1) / 2; - Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - B : Complex := (Big, Big); - X : Complex := (0.0, 0.0); - Z : Complex; - begin - if Real'Machine_Overflows then - Z := B / X; - Report.Failed ("test 3 - Constraint_Error not raised"); - Check (Z, Z, "not executed - optimizer thwarting", 0.0); - end if; - exception - when Constraint_Error => null; -- expected - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - T : constant := Real'Model_EMin + 1; - Tiny : constant := (1.0 * Real'Machine_Radix) ** T; - U : Complex := (Tiny, Tiny); - X : Complex := (0.0, 0.0); - Z : Complex; - begin - if Real'Machine_Overflows then - Z := U / X; - Report.Failed ("test 4 - Constraint_Error not raised"); - Check (Z, Z, "not executed - optimizer thwarting", 0.0); - end if; - exception - when Constraint_Error => null; -- expected - when others => - Report.Failed ("exception in test 4"); - end; - - - --- test 5 --- - declare - X : Complex := (Sqrt2, Sqrt2); - Z : Complex; - Expected : constant Complex := (0.0, 4.0); - begin - Z := X * X; - Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 5"); - when others => - Report.Failed ("exception in test 5"); - end; - - --- test 6 --- - declare - X : Complex := Sqrt3 - Sqrt3 * i; - Z : Complex; - Expected : constant Complex := (0.0, -6.0); - begin - Z := X * X; - Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 6"); - when others => - Report.Failed ("exception in test 6"); - end; - - --- test 7 --- - declare - X : Complex := Sqrt2 + Sqrt2 * i; - Y : Complex := Sqrt2 - Sqrt2 * i; - Z : Complex; - Expected : constant Complex := 0.0 + i; - begin - Z := X / Y; - Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)", - Divide_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 7"); - when others => - Report.Failed ("exception in test 7"); - end; - end Special_Values; - - - procedure Do_Mult_Div (X, Y : Complex) is - Z : Complex; - Args : constant String := - "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " & - "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ; - begin - Z := (X * X) / X; - Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE); - Z := (X * Y) / X; - Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE); - Z := (X * Y) / Y; - Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args); - when others => - Report.Failed ("exception in Do_Mult_Div for " & Args); - end Do_Mult_Div; - - -- select complex values X and Y where the real and imaginary - -- parts are selected from the ranges (1/radix..1) and - -- (1..radix). This translates into quite a few combinations. - procedure Mult_Div_Check is - Samples : constant := 17; - Radix : constant Real := Real(Real'Machine_Radix); - Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix); - Low_Sample : Real; -- (1/radix .. 1) - High_Sample : Real; -- (1 .. radix) - Sample : array (1..2) of Real; - X, Y : Complex; - begin - for I in 1 .. Samples loop - Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) + - Inv_Radix; - Sample (1) := Low_Sample; - for J in 1 .. Samples loop - High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) + - Radix; - Sample (2) := High_Sample; - for K in 1 .. 2 loop - for L in 1 .. 2 loop - X := Complex'(Sample (K), Sample (L)); - Y := Complex'(Sample (L), Sample (K)); - Do_Mult_Div (X, Y); - if Failure_Detected then - return; -- minimize flood of error messages - end if; - end loop; - end loop; - end loop; -- J - end loop; -- I - end Mult_Div_Check; - - - procedure Do_Test is - begin - Special_Values; - Mult_Div_Check; - end Do_Test; - end Float_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - -- check the floating point type with the most digits - - package A_Long_Float_Check is - type A_Long_Float is digits System.Max_Digits; - subtype Real is A_Long_Float; - procedure Do_Test; - end A_Long_Float_Check; - - package body A_Long_Float_Check is - - package Complex_Types is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Types; - - -- keep track if an accuracy failure has occurred so the test - -- can be short-circuited to avoid thousands of error messages. - Failure_Detected : Boolean := False; - - Mult_MBE : constant Real := 5.0; - Divide_MBE : constant Real := 13.0; - - - procedure Check (Actual, Expected : Complex; - Test_Name : String; - MBE : Real) 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 := MBE * abs Expected.Re * Real'Model_Epsilon; - Abs_Error := MBE * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - - if abs (Actual.Re - Expected.Re) > Max_Error then - Failure_Detected := True; - Report.Failed (Test_Name & - " actual.re: " & Real'Image (Actual.Re) & - " expected.re: " & Real'Image (Expected.Re) & - " difference.re " & - Real'Image (Actual.Re - Expected.Re) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result for real part"); - else - Report.Comment (Test_Name & " passed for real part"); - end if; - end if; - - Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - if abs (Actual.Im - Expected.Im) > Max_Error then - Failure_Detected := True; - Report.Failed (Test_Name & - " actual.im: " & Real'Image (Actual.Im) & - " expected.im: " & Real'Image (Expected.Im) & - " difference.im " & - Real'Image (Actual.Im - Expected.Im) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result for imaginary part"); - else - Report.Comment (Test_Name & " passed for imaginary part"); - end if; - end if; - end Check; - - - procedure Special_Values is - begin - - --- test 1 --- - declare - T : constant := (Real'Machine_EMax - 1) / 2; - Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - Expected : Complex := (0.0, 0.0); - X : Complex := (0.0, 0.0); - Y : Complex := (Big, Big); - Z : Complex; - begin - Z := X * Y; - Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)", - Mult_MBE); - Z := Y * X; - Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - T : constant := Real'Model_EMin + 1; - Tiny : constant := (1.0 * Real'Machine_Radix) ** T; - U : Complex := (Tiny, Tiny); - X : Complex := (0.0, 0.0); - Expected : Complex := (0.0, 0.0); - Z : Complex; - begin - Z := U * X; - Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - T : constant := (Real'Machine_EMax - 1) / 2; - Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - B : Complex := (Big, Big); - X : Complex := (0.0, 0.0); - Z : Complex; - begin - if Real'Machine_Overflows then - Z := B / X; - Report.Failed ("test 3 - Constraint_Error not raised"); - Check (Z, Z, "not executed - optimizer thwarting", 0.0); - end if; - exception - when Constraint_Error => null; -- expected - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - T : constant := Real'Model_EMin + 1; - Tiny : constant := (1.0 * Real'Machine_Radix) ** T; - U : Complex := (Tiny, Tiny); - X : Complex := (0.0, 0.0); - Z : Complex; - begin - if Real'Machine_Overflows then - Z := U / X; - Report.Failed ("test 4 - Constraint_Error not raised"); - Check (Z, Z, "not executed - optimizer thwarting", 0.0); - end if; - exception - when Constraint_Error => null; -- expected - when others => - Report.Failed ("exception in test 4"); - end; - - - --- test 5 --- - declare - X : Complex := (Sqrt2, Sqrt2); - Z : Complex; - Expected : constant Complex := (0.0, 4.0); - begin - Z := X * X; - Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 5"); - when others => - Report.Failed ("exception in test 5"); - end; - - --- test 6 --- - declare - X : Complex := Sqrt3 - Sqrt3 * i; - Z : Complex; - Expected : constant Complex := (0.0, -6.0); - begin - Z := X * X; - Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 6"); - when others => - Report.Failed ("exception in test 6"); - end; - - --- test 7 --- - declare - X : Complex := Sqrt2 + Sqrt2 * i; - Y : Complex := Sqrt2 - Sqrt2 * i; - Z : Complex; - Expected : constant Complex := 0.0 + i; - begin - Z := X / Y; - Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)", - Divide_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 7"); - when others => - Report.Failed ("exception in test 7"); - end; - end Special_Values; - - - procedure Do_Mult_Div (X, Y : Complex) is - Z : Complex; - Args : constant String := - "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " & - "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ; - begin - Z := (X * X) / X; - Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE); - Z := (X * Y) / X; - Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE); - Z := (X * Y) / Y; - Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args); - when others => - Report.Failed ("exception in Do_Mult_Div for " & Args); - end Do_Mult_Div; - - -- select complex values X and Y where the real and imaginary - -- parts are selected from the ranges (1/radix..1) and - -- (1..radix). This translates into quite a few combinations. - procedure Mult_Div_Check is - Samples : constant := 17; - Radix : constant Real := Real(Real'Machine_Radix); - Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix); - Low_Sample : Real; -- (1/radix .. 1) - High_Sample : Real; -- (1 .. radix) - Sample : array (1..2) of Real; - X, Y : Complex; - begin - for I in 1 .. Samples loop - Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) + - Inv_Radix; - Sample (1) := Low_Sample; - for J in 1 .. Samples loop - High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) + - Radix; - Sample (2) := High_Sample; - for K in 1 .. 2 loop - for L in 1 .. 2 loop - X := Complex'(Sample (K), Sample (L)); - Y := Complex'(Sample (L), Sample (K)); - Do_Mult_Div (X, Y); - if Failure_Detected then - return; -- minimize flood of error messages - end if; - end loop; - end loop; - end loop; -- J - end loop; -- I - end Mult_Div_Check; - - - procedure Do_Test is - begin - Special_Values; - Mult_Div_Check; - end Do_Test; - end A_Long_Float_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - package Non_Generic_Check is - subtype Real is Float; - procedure Do_Test; - end Non_Generic_Check; - - package body Non_Generic_Check is - - use Ada.Numerics.Complex_Types; - - -- keep track if an accuracy failure has occurred so the test - -- can be short-circuited to avoid thousands of error messages. - Failure_Detected : Boolean := False; - - Mult_MBE : constant Real := 5.0; - Divide_MBE : constant Real := 13.0; - - - procedure Check (Actual, Expected : Complex; - Test_Name : String; - MBE : Real) 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 := MBE * abs Expected.Re * Real'Model_Epsilon; - Abs_Error := MBE * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - - if abs (Actual.Re - Expected.Re) > Max_Error then - Failure_Detected := True; - Report.Failed (Test_Name & - " actual.re: " & Real'Image (Actual.Re) & - " expected.re: " & Real'Image (Expected.Re) & - " difference.re " & - Real'Image (Actual.Re - Expected.Re) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result for real part"); - else - Report.Comment (Test_Name & " passed for real part"); - end if; - end if; - - Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - if abs (Actual.Im - Expected.Im) > Max_Error then - Failure_Detected := True; - Report.Failed (Test_Name & - " actual.im: " & Real'Image (Actual.Im) & - " expected.im: " & Real'Image (Expected.Im) & - " difference.im " & - Real'Image (Actual.Im - Expected.Im) & - " mre:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result for imaginary part"); - else - Report.Comment (Test_Name & " passed for imaginary part"); - end if; - end if; - end Check; - - - procedure Special_Values is - begin - - --- test 1 --- - declare - T : constant := (Real'Machine_EMax - 1) / 2; - Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - Expected : Complex := (0.0, 0.0); - X : Complex := (0.0, 0.0); - Y : Complex := (Big, Big); - Z : Complex; - begin - Z := X * Y; - Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)", - Mult_MBE); - Z := Y * X; - Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - T : constant := Real'Model_EMin + 1; - Tiny : constant := (1.0 * Real'Machine_Radix) ** T; - U : Complex := (Tiny, Tiny); - X : Complex := (0.0, 0.0); - Expected : Complex := (0.0, 0.0); - Z : Complex; - begin - Z := U * X; - Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - T : constant := (Real'Machine_EMax - 1) / 2; - Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T); - B : Complex := (Big, Big); - X : Complex := (0.0, 0.0); - Z : Complex; - begin - if Real'Machine_Overflows then - Z := B / X; - Report.Failed ("test 3 - Constraint_Error not raised"); - Check (Z, Z, "not executed - optimizer thwarting", 0.0); - end if; - exception - when Constraint_Error => null; -- expected - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - T : constant := Real'Model_EMin + 1; - Tiny : constant := (1.0 * Real'Machine_Radix) ** T; - U : Complex := (Tiny, Tiny); - X : Complex := (0.0, 0.0); - Z : Complex; - begin - if Real'Machine_Overflows then - Z := U / X; - Report.Failed ("test 4 - Constraint_Error not raised"); - Check (Z, Z, "not executed - optimizer thwarting", 0.0); - end if; - exception - when Constraint_Error => null; -- expected - when others => - Report.Failed ("exception in test 4"); - end; - - - --- test 5 --- - declare - X : Complex := (Sqrt2, Sqrt2); - Z : Complex; - Expected : constant Complex := (0.0, 4.0); - begin - Z := X * X; - Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 5"); - when others => - Report.Failed ("exception in test 5"); - end; - - --- test 6 --- - declare - X : Complex := Sqrt3 - Sqrt3 * i; - Z : Complex; - Expected : constant Complex := (0.0, -6.0); - begin - Z := X * X; - Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)", - Mult_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 6"); - when others => - Report.Failed ("exception in test 6"); - end; - - --- test 7 --- - declare - X : Complex := Sqrt2 + Sqrt2 * i; - Y : Complex := Sqrt2 - Sqrt2 * i; - Z : Complex; - Expected : constant Complex := 0.0 + i; - begin - Z := X / Y; - Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)", - Divide_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 7"); - when others => - Report.Failed ("exception in test 7"); - end; - end Special_Values; - - - procedure Do_Mult_Div (X, Y : Complex) is - Z : Complex; - Args : constant String := - "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " & - "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ; - begin - Z := (X * X) / X; - Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE); - Z := (X * Y) / X; - Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE); - Z := (X * Y) / Y; - Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args); - when others => - Report.Failed ("exception in Do_Mult_Div for " & Args); - end Do_Mult_Div; - - -- select complex values X and Y where the real and imaginary - -- parts are selected from the ranges (1/radix..1) and - -- (1..radix). This translates into quite a few combinations. - procedure Mult_Div_Check is - Samples : constant := 17; - Radix : constant Real := Real(Real'Machine_Radix); - Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix); - Low_Sample : Real; -- (1/radix .. 1) - High_Sample : Real; -- (1 .. radix) - Sample : array (1..2) of Real; - X, Y : Complex; - begin - for I in 1 .. Samples loop - Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) + - Inv_Radix; - Sample (1) := Low_Sample; - for J in 1 .. Samples loop - High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) + - Radix; - Sample (2) := High_Sample; - for K in 1 .. 2 loop - for L in 1 .. 2 loop - X := Complex'(Sample (K), Sample (L)); - Y := Complex'(Sample (L), Sample (K)); - Do_Mult_Div (X, Y); - if Failure_Detected then - return; -- minimize flood of error messages - end if; - end loop; - end loop; - end loop; -- J - end loop; -- I - end Mult_Div_Check; - - - procedure Do_Test is - begin - Special_Values; - Mult_Div_Check; - end Do_Test; - end Non_Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - -begin - Report.Test ("CXG2008", - "Check the accuracy of the complex multiplication and" & - " division operators"); - - 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; - - if Verbose then - Report.Comment ("checking non-generic package"); - end if; - - Non_Generic_Check.Do_Test; - - Report.Result; -end CXG2008; 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; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a deleted file mode 100644 index 4140a487526..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a +++ /dev/null @@ -1,892 +0,0 @@ --- CXG2010.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 exp function returns --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test contains three test packages that are almost --- identical. The first two packages differ only in the --- floating point type that is being tested. The first --- and third package differ only in whether the generic --- elementary functions package or the pre-instantiated --- package is used. --- The test package is not generic so that the arguments --- and expected results for some of the test values --- can be expressed as universal real instead of being --- computed at runtime. --- --- 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 and where the Machine_Radix is 2, 4, 8, or 16. --- This test only applies to the Strict Mode for numerical --- accuracy. --- --- --- CHANGE HISTORY: --- 1 Mar 96 SAIC Initial release for 2.1 --- 2 Sep 96 SAIC Improved check routine --- ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- - --- --- Notes on derivation of error bound for exp(p)*exp(-p) --- --- Let a = true value of exp(p) and ac be the computed value. --- Then a = ac(1+e1), where |e1| <= 4*Model_Epsilon. --- Similarly, let b = true value of exp(-p) and bc be the computed value. --- Then b = bc(1+e2), where |e2| <= 4*ME. --- --- The product of x and y is (x*y)(1+e3), where |e3| <= 1.0ME --- --- Hence, the computed ab is [ac(1+e1)*bc(1+e2)](1+e3) = --- (ac*bc)[1 + e1 + e2 + e3 + e1e2 + e1e3 + e2e3 + e1e2e3). --- --- Throwing away the last four tiny terms, we have (ac*bc)(1 + eta), --- --- where |eta| <= (4+4+1)ME = 9.0Model_Epsilon. - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -with Ada.Numerics.Elementary_Functions; -procedure CXG2010 is - Verbose : constant Boolean := False; - Max_Samples : constant := 1000; - Accuracy_Error_Reported : Boolean := False; - - package Float_Check is - subtype Real is Float; - procedure Do_Test; - end Float_Check; - - package body Float_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real) return Real renames - Elementary_Functions.Sqrt; - function Exp (X : Real) return Real renames - Elementary_Functions.Exp; - - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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; - - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Argument_Range_Check_1 (A, B : Real; - Test : String) is - -- test a evenly distributed selection of - -- arguments selected from the range A to B. - -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) - -- The parameter One_Minus_Exp_Minus_V is the value - -- 1.0 - Exp (-V) - -- accurate to machine precision. - -- This procedure is a translation of part of Cody's test - X : Real; - Y : Real; - ZX, ZY : Real; - V : constant := 1.0 / 16.0; - One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2; - - begin - Accuracy_Error_Reported := False; - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - Y := X - V; - if Y < 0.0 then - X := Y + V; - end if; - - ZX := Exp (X); - ZY := Exp (Y); - - -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V); - -- which simplifies to ZX := Exp (X-V); - ZX := ZX - ZX * One_Minus_Exp_Minus_V; - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (ZY, ZX, - "test " & Test & " -" & - Integer'Image (I) & - " exp (" & Real'Image (X) & ")", - 9.0); - exit when Accuracy_Error_Reported; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check 1"); - when others => - Report.Failed ("exception in argument range check 1"); - end Argument_Range_Check_1; - - - - procedure Argument_Range_Check_2 (A, B : Real; - Test : String) is - -- test a evenly distributed selection of - -- arguments selected from the range A to B. - -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) - -- The parameter One_Minus_Exp_Minus_V is the value - -- 1.0 - Exp (-V) - -- accurate to machine precision. - -- This procedure is a translation of part of Cody's test - X : Real; - Y : Real; - ZX, ZY : Real; - V : constant := 45.0 / 16.0; - -- 1/16 - Exp(45/16) - Coeff : constant := 2.4453321046920570389E-3; - - begin - Accuracy_Error_Reported := False; - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - Y := X - V; - if Y < 0.0 then - X := Y + V; - end if; - - ZX := Exp (X); - ZY := Exp (Y); - - -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff; - -- where Coeff is 1/16 - Exp(45/16) - -- which simplifies to ZX := Exp (X-V); - ZX := ZX * 0.0625 - ZX * Coeff; - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (ZY, ZX, - "test " & Test & " -" & - Integer'Image (I) & - " exp (" & Real'Image (X) & ")", - 9.0); - exit when Accuracy_Error_Reported; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check 2"); - when others => - Report.Failed ("exception in argument range check 2"); - end Argument_Range_Check_2; - - - procedure Do_Test is - begin - - --- test 1 --- - declare - Y : Real; - begin - Y := Exp(1.0); - -- normal accuracy requirements - Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - Y : Real; - begin - Y := Exp(16.0) * Exp(-16.0); - Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - Y : Real; - begin - Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi); - Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - Y : Real; - begin - Y := Exp(0.0); - Check (Y, 1.0, "test 4 -- exp(0.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - - --- test 5 --- - -- constants used here only have 19 digits of precision - if Real'Digits > 19 then - Error_Low_Bound := 0.00000_00000_00000_0001; - Report.Comment ("exp accuracy checked to 19 digits"); - end if; - - Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), - 1.0, - "5"); - Error_Low_Bound := 0.0; -- reset - - --- test 6 --- - -- constants used here only have 19 digits of precision - if Real'Digits > 19 then - Error_Low_Bound := 0.00000_00000_00000_0001; - Report.Comment ("exp accuracy checked to 19 digits"); - end if; - - Argument_Range_Check_2 (1.0, - Sqrt(Real(Real'Machine_Radix)), - "6"); - Error_Low_Bound := 0.0; -- reset - - end Do_Test; - end Float_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - - - package A_Long_Float_Check is - subtype Real is A_Long_Float; - procedure Do_Test; - end A_Long_Float_Check; - - package body A_Long_Float_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real) return Real renames - Elementary_Functions.Sqrt; - function Exp (X : Real) return Real renames - Elementary_Functions.Exp; - - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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; - - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Argument_Range_Check_1 (A, B : Real; - Test : String) is - -- test a evenly distributed selection of - -- arguments selected from the range A to B. - -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) - -- The parameter One_Minus_Exp_Minus_V is the value - -- 1.0 - Exp (-V) - -- accurate to machine precision. - -- This procedure is a translation of part of Cody's test - X : Real; - Y : Real; - ZX, ZY : Real; - V : constant := 1.0 / 16.0; - One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2; - - begin - Accuracy_Error_Reported := False; - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - Y := X - V; - if Y < 0.0 then - X := Y + V; - end if; - - ZX := Exp (X); - ZY := Exp (Y); - - -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V); - -- which simplifies to ZX := Exp (X-V); - ZX := ZX - ZX * One_Minus_Exp_Minus_V; - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (ZY, ZX, - "test " & Test & " -" & - Integer'Image (I) & - " exp (" & Real'Image (X) & ")", - 9.0); - exit when Accuracy_Error_Reported; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check 1"); - when others => - Report.Failed ("exception in argument range check 1"); - end Argument_Range_Check_1; - - - - procedure Argument_Range_Check_2 (A, B : Real; - Test : String) is - -- test a evenly distributed selection of - -- arguments selected from the range A to B. - -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) - -- The parameter One_Minus_Exp_Minus_V is the value - -- 1.0 - Exp (-V) - -- accurate to machine precision. - -- This procedure is a translation of part of Cody's test - X : Real; - Y : Real; - ZX, ZY : Real; - V : constant := 45.0 / 16.0; - -- 1/16 - Exp(45/16) - Coeff : constant := 2.4453321046920570389E-3; - - begin - Accuracy_Error_Reported := False; - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - Y := X - V; - if Y < 0.0 then - X := Y + V; - end if; - - ZX := Exp (X); - ZY := Exp (Y); - - -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff; - -- where Coeff is 1/16 - Exp(45/16) - -- which simplifies to ZX := Exp (X-V); - ZX := ZX * 0.0625 - ZX * Coeff; - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (ZY, ZX, - "test " & Test & " -" & - Integer'Image (I) & - " exp (" & Real'Image (X) & ")", - 9.0); - exit when Accuracy_Error_Reported; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check 2"); - when others => - Report.Failed ("exception in argument range check 2"); - end Argument_Range_Check_2; - - - procedure Do_Test is - begin - - --- test 1 --- - declare - Y : Real; - begin - Y := Exp(1.0); - -- normal accuracy requirements - Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - Y : Real; - begin - Y := Exp(16.0) * Exp(-16.0); - Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - Y : Real; - begin - Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi); - Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - Y : Real; - begin - Y := Exp(0.0); - Check (Y, 1.0, "test 4 -- exp(0.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - - --- test 5 --- - -- constants used here only have 19 digits of precision - if Real'Digits > 19 then - Error_Low_Bound := 0.00000_00000_00000_0001; - Report.Comment ("exp accuracy checked to 19 digits"); - end if; - - Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), - 1.0, - "5"); - Error_Low_Bound := 0.0; -- reset - - --- test 6 --- - -- constants used here only have 19 digits of precision - if Real'Digits > 19 then - Error_Low_Bound := 0.00000_00000_00000_0001; - Report.Comment ("exp accuracy checked to 19 digits"); - end if; - - Argument_Range_Check_2 (1.0, - Sqrt(Real(Real'Machine_Radix)), - "6"); - Error_Low_Bound := 0.0; -- reset - - end Do_Test; - end A_Long_Float_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - package Non_Generic_Check is - procedure Do_Test; - subtype Real is Float; - end Non_Generic_Check; - - package body Non_Generic_Check is - - package Elementary_Functions renames - Ada.Numerics.Elementary_Functions; - function Sqrt (X : Real) return Real renames - Elementary_Functions.Sqrt; - function Exp (X : Real) return Real renames - Elementary_Functions.Exp; - - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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; - - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Argument_Range_Check_1 (A, B : Real; - Test : String) is - -- test a evenly distributed selection of - -- arguments selected from the range A to B. - -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) - -- The parameter One_Minus_Exp_Minus_V is the value - -- 1.0 - Exp (-V) - -- accurate to machine precision. - -- This procedure is a translation of part of Cody's test - X : Real; - Y : Real; - ZX, ZY : Real; - V : constant := 1.0 / 16.0; - One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2; - - begin - Accuracy_Error_Reported := False; - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - Y := X - V; - if Y < 0.0 then - X := Y + V; - end if; - - ZX := Exp (X); - ZY := Exp (Y); - - -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V); - -- which simplifies to ZX := Exp (X-V); - ZX := ZX - ZX * One_Minus_Exp_Minus_V; - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (ZY, ZX, - "test " & Test & " -" & - Integer'Image (I) & - " exp (" & Real'Image (X) & ")", - 9.0); - exit when Accuracy_Error_Reported; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check 1"); - when others => - Report.Failed ("exception in argument range check 1"); - end Argument_Range_Check_1; - - - - procedure Argument_Range_Check_2 (A, B : Real; - Test : String) is - -- test a evenly distributed selection of - -- arguments selected from the range A to B. - -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V) - -- The parameter One_Minus_Exp_Minus_V is the value - -- 1.0 - Exp (-V) - -- accurate to machine precision. - -- This procedure is a translation of part of Cody's test - X : Real; - Y : Real; - ZX, ZY : Real; - V : constant := 45.0 / 16.0; - -- 1/16 - Exp(45/16) - Coeff : constant := 2.4453321046920570389E-3; - - begin - Accuracy_Error_Reported := False; - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - Y := X - V; - if Y < 0.0 then - X := Y + V; - end if; - - ZX := Exp (X); - ZY := Exp (Y); - - -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff; - -- where Coeff is 1/16 - Exp(45/16) - -- which simplifies to ZX := Exp (X-V); - ZX := ZX * 0.0625 - ZX * Coeff; - - -- note that since the expected value is computed, we - -- must take the error in that computation into account. - Check (ZY, ZX, - "test " & Test & " -" & - Integer'Image (I) & - " exp (" & Real'Image (X) & ")", - 9.0); - exit when Accuracy_Error_Reported; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in argument range check 2"); - when others => - Report.Failed ("exception in argument range check 2"); - end Argument_Range_Check_2; - - - procedure Do_Test is - begin - - --- test 1 --- - declare - Y : Real; - begin - Y := Exp(1.0); - -- normal accuracy requirements - Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - Y : Real; - begin - Y := Exp(16.0) * Exp(-16.0); - Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - Y : Real; - begin - Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi); - Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - Y : Real; - begin - Y := Exp(0.0); - Check (Y, 1.0, "test 4 -- exp(0.0)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - - --- test 5 --- - -- constants used here only have 19 digits of precision - if Real'Digits > 19 then - Error_Low_Bound := 0.00000_00000_00000_0001; - Report.Comment ("exp accuracy checked to 19 digits"); - end if; - - Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), - 1.0, - "5"); - Error_Low_Bound := 0.0; -- reset - - --- test 6 --- - -- constants used here only have 19 digits of precision - if Real'Digits > 19 then - Error_Low_Bound := 0.00000_00000_00000_0001; - Report.Comment ("exp accuracy checked to 19 digits"); - end if; - - Argument_Range_Check_2 (1.0, - Sqrt(Real(Real'Machine_Radix)), - "6"); - Error_Low_Bound := 0.0; -- reset - - end Do_Test; - end Non_Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - -begin - Report.Test ("CXG2010", - "Check the accuracy of the exp function"); - - -- the test only applies to machines with a radix of 2,4,8, or 16 - case Float'Machine_Radix is - when 2 | 4 | 8 | 16 => null; - when others => - Report.Not_Applicable ("only applicable to binary radix"); - Report.Result; - return; - end case; - - 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; - - if Verbose then - Report.Comment ("checking non-generic package"); - end if; - - Non_Generic_Check.Do_Test; - - Report.Result; -end CXG2010; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a deleted file mode 100644 index 2c018b1321e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a +++ /dev/null @@ -1,490 +0,0 @@ --- CXG2011.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 log function returns --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks in a range where a Taylor series can be used to compute --- the expected result. --- Checks that use an identity for determining the result. --- Exception checks. --- --- 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: --- 1 Mar 96 SAIC Initial release for 2.1 --- 22 Aug 96 SAIC Improved Check routine --- 02 DEC 97 EDS Log (0.0) must raise Constraint_Error, --- not Argument_Error ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -procedure CXG2011 is - Verbose : constant Boolean := False; - Max_Samples : constant := 1000; - - -- CRC Handbook Page 738 - Ln10 : constant := 2.30258_50929_94045_68401_79914_54684_36420_76011_01489; - Ln2 : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755_00134; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real'Base) return Real'Base renames - Elementary_Functions.Sqrt; - function Exp (X : Real'Base) return Real'Base renames - Elementary_Functions.Exp; - function Log (X : Real'Base) return Real'Base renames - Elementary_Functions.Log; - function Log (X, Base : Real'Base) return Real'Base renames - Elementary_Functions.Log; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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; - - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Special_Value_Test is - begin - - --- test 1 --- - declare - Y : Real; - begin - Y := Log(1.0); - Check (Y, 0.0, "special value test 1 -- log(1)", - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 1"); - when others => - Report.Failed ("exception in test 1"); - end; - - --- test 2 --- - declare - Y : Real; - begin - Y := Log(10.0); - Check (Y, Ln10, "special value test 2 -- log(10)", 4.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 2"); - when others => - Report.Failed ("exception in test 2"); - end; - - --- test 3 --- - declare - Y : Real; - begin - Y := Log (2.0); - Check (Y, Ln2, "special value test 3 -- log(2)", 4.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 3"); - when others => - Report.Failed ("exception in test 3"); - end; - - --- test 4 --- - declare - Y : Real; - begin - Y := Log (2.0 ** 18, 2.0); - Check (Y, 18.0, "special value test 4 -- log(2**18,2)", 4.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in test 4"); - when others => - Report.Failed ("exception in test 4"); - end; - end Special_Value_Test; - - - procedure Taylor_Series_Test is - -- Use a 4 term taylor series expansion to check a selection of - -- arguments very near 1.0. - -- The range is chosen so that the 4 term taylor series will - -- provide accuracy to machine precision. Cody pg 49-50. - Half_Range : constant Real := Real'Model_Epsilon * 50.0; - A : constant Real := 1.0 - Half_Range; - B : constant Real := 1.0 + Half_Range; - X : Real; - Xm1 : Real; - Expected : Real; - Actual : Real; - - begin - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - - Xm1 := X - 1.0; - -- The following is the first 4 terms of the taylor series - -- that has been rearranged to minimize error in the calculation - Expected := (Xm1 * (1.0/3.0 - Xm1/4.0) - 0.5) * Xm1 * Xm1 + Xm1; - - Actual := Log (X); - Check (Actual, Expected, - "Taylor Series Test -" & - Integer'Image (I) & - " log (" & Real'Image (X) & ")", - 4.0); - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Taylor Series Test"); - when others => - Report.Failed ("exception in Taylor Series Test"); - end Taylor_Series_Test; - - - - procedure Log_Difference_Identity is - -- Check using the identity ln(x) = ln(17x/16) - ln(17/16) - -- over the range A to B. - -- The selected range assures that both X and 17x/16 will - -- have the same exponents and neither argument gets too close - -- to 1. Cody pg 50. - A : constant Real := 1.0 / Sqrt (2.0); - B : constant Real := 15.0 / 16.0; - X : Real; - Expected : Real; - Actual : Real; - begin - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - -- magic argument purification - X := Real'Machine (Real'Machine (X+8.0) - 8.0); - - Expected := Log (X + X / 16.0) - Log (17.0/16.0); - - Actual := Log (X); - Check (Actual, Expected, - "Log Difference Identity -" & - Integer'Image (I) & - " log (" & Real'Image (X) & ")", - 4.0); - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Log Difference Identity Test"); - when others => - Report.Failed ("exception in Log Difference Identity Test"); - end Log_Difference_Identity; - - - procedure Log_Product_Identity is - -- Check using the identity ln(x**2) = 2ln(x) - -- over the range A to B. - -- This large range is chosen to minimize the possibility of - -- undetected systematic errors. Cody pg 53. - A : constant Real := 16.0; - B : constant Real := 240.0; - X : Real; - Expected : Real; - Actual : Real; - begin - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - -- magic argument purification - X := Real'Machine (Real'Machine (X+8.0) - 8.0); - - Expected := 2.0 * Log (X); - - Actual := Log (X*X); - Check (Actual, Expected, - "Log Product Identity -" & - Integer'Image (I) & - " log (" & Real'Image (X) & ")", - 4.0); - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Log Product Identity Test"); - when others => - Report.Failed ("exception in Log Product Identity Test"); - end Log_Product_Identity; - - - procedure Log10_Test is - -- Check using the identity log(x) = log(11x/10) - log(1.1) - -- over the range A to B. See Cody pg 52. - A : constant Real := 1.0 / Sqrt (10.0); - B : constant Real := 0.9; - X : Real; - Expected : Real; - Actual : Real; - begin - if Real'Digits > 17 then - -- constant used below is accuract to 17 digits - Error_Low_Bound := 0.00000_00000_00000_01; - Report.Comment ("log accuracy checked to 19 digits"); - end if; - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - - Expected := Log (X + X/10.0, 10.0) - - 3.77060_15822_50407_5E-4 - 21.0 / 512.0; - - Actual := Log (X, 10.0); - Check (Actual, Expected, - "Log 10 Test -" & - Integer'Image (I) & - " log (" & Real'Image (X) & ")", - 4.0); - - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - exit when Accuracy_Error_Reported; - end loop; - Error_Low_Bound := 0.0; -- reset - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Log 10 Test"); - when others => - Report.Failed ("exception in Log 10 Test"); - end Log10_Test; - - - procedure Exception_Test is - X1, X2, X3, X4 : Real; - begin - begin - X1 := Log (0.0); - Report.Failed ("exception not raised for LOG(0)"); - exception - -- Log (0.0) must raise Constraint_Error, not Argument_Error, - -- as per A.5.1(28,29). Was incorrect in ACVC 2.1 release. - when Ada.Numerics.Argument_Error => - Report.Failed ("Argument_Error raised instead of" & - " Constraint_Error for LOG(0)--A.5.1(28,29)"); - when Constraint_Error => null; -- ok - when others => - Report.Failed ("wrong exception raised for LOG(0)"); - end; - - begin - X2 := Log ( 1.0, 0.0); - Report.Failed ("exception not raised for LOG(1,0)"); - exception - when Ada.Numerics.Argument_Error => null; -- ok - when Constraint_Error => - Report.Failed ("constraint_error raised instead of" & - " argument_error for LOG(1,0)"); - when others => - Report.Failed ("wrong exception raised for LOG(1,0)"); - end; - - begin - X3 := Log (1.0, 1.0); - Report.Failed ("exception not raised for LOG(1,1)"); - exception - when Ada.Numerics.Argument_Error => null; -- ok - when Constraint_Error => - Report.Failed ("constraint_error raised instead of" & - " argument_error for LOG(1,1)"); - when others => - Report.Failed ("wrong exception raised for LOG(1,1)"); - end; - - begin - X4 := Log (1.0, -10.0); - Report.Failed ("exception not raised for LOG(1,-10)"); - exception - when Ada.Numerics.Argument_Error => null; -- ok - when Constraint_Error => - Report.Failed ("constraint_error raised instead of" & - " argument_error for LOG(1,-10)"); - when others => - Report.Failed ("wrong exception raised for LOG(1,-10)"); - end; - - -- optimizer thwarting - if Report.Ident_Bool (False) then - Report.Comment (Real'Image (X1+X2+X3+X4)); - end if; - end Exception_Test; - - - procedure Do_Test is - begin - Special_Value_Test; - Taylor_Series_Test; - Log_Difference_Identity; - Log_Product_Identity; - Log10_Test; - Exception_Test; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2011", - "Check the accuracy of the log function"); - - 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 CXG2011; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a deleted file mode 100644 index 6a665d0e077..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a +++ /dev/null @@ -1,438 +0,0 @@ --- CXG2012.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 exponentiation operator returns --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks that use an identity for determining the result. --- Exception checks. --- While this test concentrates on the "**" operator --- defined in Generic_Elementary_Functions, a check is also --- performed on the standard "**" operator. --- --- 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: --- 7 Mar 96 SAIC Initial release for 2.1 --- 2 Sep 96 SAIC Improvements as suggested by reviewers --- 3 Jun 98 EDS Add parens to ensure that the expression is not --- evaluated by multiplying its two large terms --- together and overflowing. --- 3 Dec 01 RLB Added 'Machine to insure that equality tests --- are certain to work. --- ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -procedure CXG2012 is - Verbose : constant Boolean := False; - Max_Samples : constant := 1000; - - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; - - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real) return Real renames - Elementary_Functions.Sqrt; - function Exp (X : Real) return Real renames - Elementary_Functions.Exp; - function Log (X : Real) return Real renames - Elementary_Functions.Log; - function "**" (L, R : Real) return Real renames - Elementary_Functions."**"; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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 - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - -- the following version of Check computes the allowed error bound - -- using the operands - procedure Check (Actual, Expected : Real; - Left, Right : Real; - Test_Name : String; - MRE_Factor : Real := 1.0) is - MRE : Real; - begin - MRE := MRE_Factor * (4.0 + abs (Right * Log(Left)) / 32.0); - Check (Actual, Expected, Test_Name, MRE); - end Check; - - - procedure Real_To_Integer_Test is - type Int_Check is - record - Left : Real; - Right : Integer; - Expected : Real; - end record; - type Int_Checks is array (Positive range <>) of Int_Check; - - -- the following tests use only model numbers so the result - -- is expected to be exact. - IC : constant Int_Checks := - ( ( 2.0, 5, 32.0), - ( -2.0, 5, -32.0), - ( 0.5, -5, 32.0), - ( 2.0, 0, 1.0), - ( 0.0, 0, 1.0) ); - begin - for I in IC'Range loop - declare - Y : Real; - begin - Y := IC (I).Left ** IC (I).Right; - Check (Y, IC (I).Expected, - "real to integer test" & - Real'Image (IC (I).Left) & " ** " & - Integer'Image (IC (I).Right), - 0.0); -- no error allowed - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in rtoi test " & - Integer'Image (I)); - when others => - Report.Failed ("exception in rtoi test " & - Integer'Image (I)); - end; - end loop; - end Real_To_Integer_Test; - - - procedure Special_Value_Test is - No_Error : constant := 0.0; - begin - Check (0.0 ** 1.0, 0.0, "0**1", No_Error); - Check (1.0 ** 0.0, 1.0, "1**0", No_Error); - - Check ( 2.0 ** 5.0, 32.0, 2.0, 5.0, "2**5"); - Check ( 0.5**(-5.0), 32.0, 0.5, -5.0, "0.5**-5"); - - Check (Sqrt2 ** 4.0, 4.0, Sqrt2, 4.0, "Sqrt2**4"); - Check (Sqrt3 ** 6.0, 27.0, Sqrt3, 6.0, "Sqrt3**6"); - - Check (2.0 ** 0.5, Sqrt2, 2.0, 0.5, "2.0**0.5"); - - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Special Value Test"); - when others => - Report.Failed ("exception in Special Value Test"); - end Special_Value_Test; - - - procedure Small_Range_Test is - -- Several checks over the range 1/radix .. 1 - A : constant Real := 1.0 / Real (Real'Machine_Radix); - B : constant Real := 1.0; - X : Real; - -- In the cases below where the expected result is - -- inexact we allow an additional error amount of - -- 1.0 * Model_Epsilon to account for that error. - -- This is accomplished by the factor of 1.25 times - -- the computed error bound (which is > 4.0) thus - -- increasing the error bound by at least - -- 1.0 * Model_Epsilon - begin - Accuracy_Error_Reported := False; -- reset - for I in 0..Max_Samples loop - X := Real'Machine((B - A) * Real (I) / Real (Max_Samples) + A); - - Check (X ** 1.0, X, -- exact result required - "Small range" & Integer'Image (I) & ": " & - Real'Image (X) & " ** 1.0", - 0.0); - - Check ((X*X) ** 1.5, X**3, X*X, 1.5, - "Small range" & Integer'Image (I) & ": " & - Real'Image (X*X) & " ** 1.5", - 1.25); - - Check (X ** 13.5, 1.0 / (X ** (-13.5)), X, 13.5, - "Small range" & Integer'Image (I) & ": " & - Real'Image (X) & " ** 13.5", - 2.0); -- 2 ** computations - - Check ((X*X) ** 1.25, X**(2.5), X*X, 1.25, - "Small range" & Integer'Image (I) & ": " & - Real'Image (X*X) & " ** 1.25", - 2.0); -- 2 ** computations - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Small Range Test"); - when others => - Report.Failed ("exception in Small Range Test"); - end Small_Range_Test; - - - procedure Large_Range_Test is - -- Check over the range A to B where A is 1.0 and - -- B is a large value. - A : constant Real := 1.0; - B : Real; - X : Real; - Iteration : Integer := 0; - Subtest : Character := 'X'; - begin - -- upper bound of range should be as large as possible where - -- B**3 is still valid. - B := Real'Safe_Last ** 0.333; - Accuracy_Error_Reported := False; -- reset - for I in 0..Max_Samples loop - Iteration := I; - Subtest := 'X'; - X := Real'Machine((B - A) * (Real (I) / Real (Max_Samples)) + A); - - Subtest := 'A'; - Check (X ** 1.0, X, -- exact result required - "Large range" & Integer'Image (I) & ": " & - Real'Image (X) & " ** 1.0", - 0.0); - - Subtest := 'B'; - Check ((X*X) ** 1.5, X**3, X*X, 1.5, - "Large range" & Integer'Image (I) & ": " & - Real'Image (X*X) & " ** 1.5", - 1.25); -- inexact expected result - - Subtest := 'C'; - Check ((X*X) ** 1.25, X**(2.5), X*X, 1.25, - "Large range" & Integer'Image (I) & ": " & - Real'Image (X*X) & " ** 1.25", - 2.0); -- two ** operators - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Large Range Test" & - Integer'Image (Iteration) & Subtest); - when others => - Report.Failed ("exception in Large Range Test" & - Integer'Image (Iteration) & Subtest); - end Large_Range_Test; - - - procedure Exception_Test is - X1, X2, X3, X4 : Real; - begin - begin - X1 := 0.0 ** (-1.0); - Report.Failed ("exception not raised for 0**-1"); - exception - when Ada.Numerics.Argument_Error => - Report.Failed ("argument_error raised instead of" & - " constraint_error for 0**-1"); - when Constraint_Error => null; -- ok - when others => - Report.Failed ("wrong exception raised for 0**-1"); - end; - - begin - X2 := 0.0 ** 0.0; - Report.Failed ("exception not raised for 0**0"); - exception - when Ada.Numerics.Argument_Error => null; -- ok - when Constraint_Error => - Report.Failed ("constraint_error raised instead of" & - " argument_error for 0**0"); - when others => - Report.Failed ("wrong exception raised for 0**0"); - end; - - begin - X3 := (-1.0) ** 1.0; - Report.Failed ("exception not raised for -1**1"); - exception - when Ada.Numerics.Argument_Error => null; -- ok - when Constraint_Error => - Report.Failed ("constraint_error raised instead of" & - " argument_error for -1**1"); - when others => - Report.Failed ("wrong exception raised for -1**1"); - end; - - begin - X4 := (-2.0) ** 2.0; - Report.Failed ("exception not raised for -2**2"); - exception - when Ada.Numerics.Argument_Error => null; -- ok - when Constraint_Error => - Report.Failed ("constraint_error raised instead of" & - " argument_error for -2**2"); - when others => - Report.Failed ("wrong exception raised for -2**2"); - end; - - -- optimizer thwarting - if Report.Ident_Bool (False) then - Report.Comment (Real'Image (X1+X2+X3+X4)); - end if; - end Exception_Test; - - - procedure Do_Test is - begin - Real_To_Integer_Test; - Special_Value_Test; - Small_Range_Test; - Large_Range_Test; - Exception_Test; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2012", - "Check the accuracy of the ** operator"); - - 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 CXG2012; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a deleted file mode 100644 index 94f180b804d..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a +++ /dev/null @@ -1,367 +0,0 @@ --- CXG2013.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 TAN and COT functions return --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks that use an identity for determining the result. --- Exception checks. --- --- 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: --- 11 Mar 96 SAIC Initial release for 2.1 --- 17 Aug 96 SAIC Commentary fixes. --- 03 Feb 97 PWB.CTA Removed checks with explicit Cycle => 2.0*Pi --- 02 DEC 97 EDS Change Max_Samples constant to 1001. --- 29 JUN 98 EDS Deleted Special_Angle_Test as fatally flawed. - ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -procedure CXG2013 is - Verbose : constant Boolean := False; - Max_Samples : constant := 1001; - - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; - - Pi : constant := Ada.Numerics.Pi; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - function Sqrt (X : Real) return Real renames - Elementary_Functions.Sqrt; - function Tan (X : Real) return Real renames - Elementary_Functions.Tan; - function Cot (X : Real) return Real renames - Elementary_Functions.Cot; - function Tan (X, Cycle : Real) return Real renames - Elementary_Functions.Tan; - function Cot (X, Cycle : Real) return Real renames - Elementary_Functions.Cot; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - -- factor to be applied in computing MRE - Maximum_Relative_Error : constant Real := 4.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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 - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - - procedure Exact_Result_Test is - No_Error : constant := 0.0; - begin - -- A.5.1(38);6.0 - Check (Tan (0.0), 0.0, "tan(0)", No_Error); - - -- A.5.1(41);6.0 - Check (Tan (180.0, 360.0), 0.0, "tan(180,360)", No_Error); - Check (Tan (360.0, 360.0), 0.0, "tan(360,360)", No_Error); - Check (Tan (720.0, 360.0), 0.0, "tan(720,360)", No_Error); - - -- A.5.1(41);6.0 - Check (Cot ( 90.0, 360.0), 0.0, "cot( 90,360)", No_Error); - Check (Cot (270.0, 360.0), 0.0, "cot(270,360)", No_Error); - Check (Cot (810.0, 360.0), 0.0, "cot(810,360)", No_Error); - - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Tan_Test (A, B : Real) is - -- Use identity Tan(X) = [2*Tan(x/2)]/[1-Tan(x/2) ** 2] - -- checks over the range -pi/4 .. pi/4 require no argument reduction - -- checks over the range 7pi/8 .. 9pi/8 require argument reduction - X, Y : Real; - Actual1, Actual2 : Real; - begin - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - -- argument purification to insure x and x/2 are exact - -- See Cody page 170. - Y := Real'Machine (X*0.5); - X := Real'Machine (Y + Y); - - Actual1 := Tan(X); - Actual2 := (2.0 * Tan (Y)) / (1.0 - Tan (Y) ** 2); - - if abs (X - Pi) > ( (B-A)/Real(2*Max_Samples) ) then - Check (Actual1, Actual2, - "Tan_Test " & Integer'Image (I) & ": tan(" & - Real'Image (X) & ") ", - (1.0 + Sqrt2) * Maximum_Relative_Error); - -- see Cody pg 165 for error bound info - end if; - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Tan_Test"); - when others => - Report.Failed ("exception in Tan_Test"); - end Tan_Test; - - - - procedure Cot_Test is - -- Use identity Cot(X) = [Cot(X/2)**2 - 1]/[2*Cot(X/2)] - A : constant := 6.0 * Pi; - B : constant := 25.0 / 4.0 * Pi; - X, Y : Real; - Actual1, Actual2 : Real; - begin - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - -- argument purification to insure x and x/2 are exact. - -- See Cody page 170. - Y := Real'Machine (X*0.5); - X := Real'Machine (Y + Y); - - Actual1 := Cot(X); - Actual2 := (Cot (Y) ** 2 - 1.0) / (2.0 * Cot (Y)); - - Check (Actual1, Actual2, - "Cot_Test " & Integer'Image (I) & ": cot(" & - Real'Image (X) & ") ", - (1.0 + Sqrt2) * Maximum_Relative_Error); - -- see Cody pg 165 for error bound info - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Cot_Test"); - when others => - Report.Failed ("exception in Cot_Test"); - end Cot_Test; - - - procedure Exception_Test is - X1, X2, X3, X4, X5 : Real := 0.0; - begin - - - begin -- A.5.1(20);6.0 - X1 := Tan (0.0, Cycle => 0.0); - Report.Failed ("no exception for cycle = 0.0"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for cycle = 0.0"); - end; - - begin -- A.5.1(20);6.0 - X2 := Cot (1.0, Cycle => -3.0); - Report.Failed ("no exception for cycle < 0.0"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for cycle < 0.0"); - end; - - -- the remaining tests only apply to machines that overflow - if Real'Machine_Overflows then -- A.5.1(28);6.0 - - begin -- A.5.1(29);6.0 - X3 := Cot (0.0); - Report.Failed ("exception not raised for cot(0)"); - exception - when Constraint_Error => null; -- ok - when others => - Report.Failed ("wrong exception raised for cot(0)"); - end; - - begin -- A.5.1(31);6.0 - X4 := Tan (90.0, 360.0); - Report.Failed ("exception not raised for tan(90,360)"); - exception - when Constraint_Error => null; -- ok - when others => - Report.Failed ("wrong exception raised for tan(90,360)"); - end; - - begin -- A.5.1(32);6.0 - X5 := Cot (180.0, 360.0); - Report.Failed ("exception not raised for cot(180,360)"); - exception - when Constraint_Error => null; -- ok - when others => - Report.Failed ("wrong exception raised for cot(180,360)"); - end; - end if; - - -- optimizer thwarting - if Report.Ident_Bool (False) then - Report.Comment (Real'Image (X1+X2+X3+X4+X5)); - end if; - end Exception_Test; - - - procedure Do_Test is - begin - Exact_Result_Test; - Tan_Test (-Pi/4.0, Pi/4.0); - Tan_Test (7.0*Pi/8.0, 9.0*Pi/8.0); - Cot_Test; - Exception_Test; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2013", - "Check the accuracy of the TAN and COT 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 CXG2013; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a deleted file mode 100644 index 48499a2556f..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a +++ /dev/null @@ -1,399 +0,0 @@ --- CXG2014.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 SINH and COSH functions return --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks that use an identity for determining the result. --- Exception checks. --- --- 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: --- 15 Mar 96 SAIC Initial release for 2.1 --- 03 Jun 98 EDS In line 80, change 1000 to 1024, making it a model --- number. Add Taylor Series terms in line 281. --- 15 Feb 99 RLB Repaired Subtraction_Error_Test to avoid precision --- problems. ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -procedure CXG2014 is - Verbose : constant Boolean := False; - Max_Samples : constant := 1024; - - E : constant := Ada.Numerics.E; - Cosh1 : constant := (E + 1.0 / E) / 2.0; -- cosh(1.0) - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - function Sinh (X : Real) return Real renames - Elementary_Functions.Sinh; - function Cosh (X : Real) return Real renames - Elementary_Functions.Cosh; - function Log (X : Real) return Real renames - Elementary_Functions.Log; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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_Small instead - -- of Model_Epsilon and Expected. - Rel_Error := MRE * abs Expected * Real'Model_Epsilon; - Abs_Error := MRE * Real'Model_Small; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Special_Value_Test is - -- In the following tests the expected result is accurate - -- to the machine precision so the minimum guaranteed error - -- bound can be used. - Minimum_Error : constant := 8.0; - begin - Check (Sinh (1.0), - (E - 1.0 / E) / 2.0, - "sinh(1)", - Minimum_Error); - Check (Cosh (1.0), - Cosh1, - "cosh(1)", - Minimum_Error); - Check (Sinh (2.0), - (E * E - (1.0 / (E * E))) / 2.0, - "sinh(2)", - Minimum_Error); - Check (Cosh (2.0), - (E * E + (1.0 / (E * E))) / 2.0, - "cosh(2)", - Minimum_Error); - Check (Sinh (-1.0), - (1.0 / E - E) / 2.0, - "sinh(-1)", - Minimum_Error); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special value test"); - when others => - Report.Failed ("exception in special value test"); - end Special_Value_Test; - - - - procedure Exact_Result_Test is - No_Error : constant := 0.0; - begin - -- A.5.1(38);6.0 - Check (Sinh (0.0), 0.0, "sinh(0)", No_Error); - Check (Cosh (0.0), 1.0, "cosh(0)", No_Error); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Identity_1_Test is - -- For the Sinh test use the identity - -- 2 * Sinh(x) * Cosh(1) = Sinh(x+1) + Sinh (x-1) - -- which is transformed to - -- Sinh(x) = ((Sinh(x+1) + Sinh(x-1)) * C - -- where C = 1/(2*Cosh(1)) - -- - -- For the Cosh test use the identity - -- 2 * Cosh(x) * Cosh(1) = Cosh(x+1) + Cosh(x-1) - -- which is transformed to - -- Cosh(x) = C * (Cosh(x+1) + Cosh(x-1)) - -- where C is the same as above - -- - -- see Cody pg 230-231 for details on the error analysis. - -- The net result is a relative error bound of 16 * Model_Epsilon. - - A : constant := 3.0; - -- large upper bound but not so large as to cause Cosh(B) - -- to overflow - B : constant Real := Log(Real'Safe_Last) - 2.0; - X_Minus_1, X, X_Plus_1 : Real; - Actual1, Actual2 : Real; - C : constant := 1.0 / (2.0 * Cosh1); - begin - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - -- make sure there is no error in x-1, x, and x+1 - X_Plus_1 := (B - A) * Real (I) / Real (Max_Samples) + A; - X_Plus_1 := Real'Machine (X_Plus_1); - X := Real'Machine (X_Plus_1 - 1.0); - X_Minus_1 := Real'Machine (X - 1.0); - - -- Sinh(x) = ((Sinh(x+1) + Sinh(x-1)) * C - Actual1 := Sinh(X); - Actual2 := C * (Sinh(X_Plus_1) + Sinh(X_Minus_1)); - - Check (Actual1, Actual2, - "Identity_1_Test " & Integer'Image (I) & ": sinh(" & - Real'Image (X) & ") ", - 16.0); - - -- Cosh(x) = C * (Cosh(x+1) + Cosh(x-1)) - Actual1 := Cosh (X); - Actual2 := C * (Cosh(X_Plus_1) + Cosh (X_Minus_1)); - Check (Actual1, Actual2, - "Identity_1_Test " & Integer'Image (I) & ": cosh(" & - Real'Image (X) & ") ", - 16.0); - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Identity_1_Test" & - " for X=" & Real'Image (X)); - when others => - Report.Failed ("exception in Identity_1_Test" & - " for X=" & Real'Image (X)); - end Identity_1_Test; - - - - procedure Subtraction_Error_Test is - -- This test detects the error resulting from subtraction if - -- the obvious algorithm was used for computing sinh. That is, - -- it it is computed as (e**x - e**-x)/2. - -- We check the result by using a Taylor series expansion that - -- will produce a result accurate to the machine precision for - -- the range under test. - -- - -- The maximum relative error bound for this test is - -- 8 for the sinh operation and 7 for the Taylor series - -- for a total of 15 * Model_Epsilon - A : constant := 0.0; - B : constant := 0.5; - X : Real; - X_Squared : Real; - Actual, Expected : Real; - begin - if Real'digits > 15 then - return; -- The approximation below is not accurate beyond - -- 15 digits. Adding more terms makes the error - -- larger, so it makes the test worse for more normal - -- values. Thus, we skip this subtest for larger than - -- 15 digits. - end if; - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - X_Squared := X * X; - - Actual := Sinh(X); - - -- The Taylor series regrouped a bit - Expected := - X * (1.0 + (X_Squared / 6.0) * - (1.0 + (X_Squared/20.0) * - (1.0 + (X_Squared/42.0) * - (1.0 + (X_Squared/72.0) * - (1.0 + (X_Squared/110.0) * - (1.0 + (X_Squared/156.0) - )))))); - - Check (Actual, Expected, - "Subtraction_Error_Test " & Integer'Image (I) & ": sinh(" & - Real'Image (X) & ") ", - 15.0); - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Subtraction_Error_Test"); - when others => - Report.Failed ("exception in Subtraction_Error_Test"); - end Subtraction_Error_Test; - - - procedure Exception_Test is - X1, X2 : Real := 0.0; - begin - -- this part of the test is only applicable if 'Machine_Overflows - -- is true. - if Real'Machine_Overflows then - - begin - X1 := Sinh (Real'Safe_Last / 2.0); - Report.Failed ("no exception for sinh overflow"); - exception - when Constraint_Error => null; - when others => - Report.Failed ("wrong exception sinh overflow"); - end; - - begin - X2 := Cosh (Real'Safe_Last / 2.0); - Report.Failed ("no exception for cosh overflow"); - exception - when Constraint_Error => null; - when others => - Report.Failed ("wrong exception cosh overflow"); - end; - - end if; - - -- optimizer thwarting - if Report.Ident_Bool (False) then - Report.Comment (Real'Image (X1 + X2)); - end if; - end Exception_Test; - - - procedure Do_Test is - begin - Special_Value_Test; - Exact_Result_Test; - Identity_1_Test; - Subtraction_Error_Test; - Exception_Test; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2014", - "Check the accuracy of the SINH and COSH 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 CXG2014; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a deleted file mode 100644 index 50fda5e1f4f..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a +++ /dev/null @@ -1,686 +0,0 @@ --- CXG2015.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 ARCSIN and ARCCOS functions return --- results that are within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks in a specific range where a Taylor series can be --- used to compute an accurate result for comparison. --- Exception checks. --- The Taylor series tests are a direct translation of the --- FORTRAN code found in the reference. --- --- 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: --- 18 Mar 96 SAIC Initial release for 2.1 --- 24 Apr 96 SAIC Fixed error bounds. --- 17 Aug 96 SAIC Added reference information and improved --- checking for machines with more than 23 --- digits of precision. --- 03 Feb 97 PWB.CTA Removed checks with explicit Cycle => 2.0*Pi --- 22 Dec 99 RLB Added model range checking to "exact" results, --- in order to avoid too strictly requiring a specific --- result, and too weakly checking results. --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- --- CELEFUNT: A Portable Test Package for Complex Elementary Functions --- ACM Collected Algorithms number 714 - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -procedure CXG2015 is - Verbose : constant Boolean := False; - Max_Samples : constant := 1000; - - - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; - - Pi : constant := Ada.Numerics.Pi; - - -- relative error bound from G.2.4(7);6.0 - Minimum_Error : constant := 4.0; - - generic - type Real is digits <>; - Half_PI_Low : in Real; -- The machine number closest to, but not greater - -- than PI/2.0. - Half_PI_High : in Real;-- The machine number closest to, but not less - -- than PI/2.0. - PI_Low : in Real; -- The machine number closest to, but not greater - -- than PI. - PI_High : in Real; -- The machine number closest to, but not less - -- than PI. - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - - function Arcsin (X : Real) return Real renames - Elementary_Functions.Arcsin; - function Arcsin (X, Cycle : Real) return Real renames - Elementary_Functions.Arcsin; - function Arccos (X : Real) return Real renames - Elementary_Functions.ArcCos; - function Arccos (X, Cycle : Real) return Real renames - Elementary_Functions.ArcCos; - - -- needed for support - function Log (X, Base : Real) return Real renames - Elementary_Functions.Log; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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; - - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Special_Value_Test is - -- In the following tests the expected result is accurate - -- to the machine precision so the minimum guaranteed error - -- bound can be used. - - type Data_Point is - record - Degrees, - Radians, - Argument, - Error_Bound : Real; - end record; - - type Test_Data_Type is array (Positive range <>) of Data_Point; - - -- the values in the following tables only involve static - -- expressions so no loss of precision occurs. However, - -- rounding can be an issue with expressions involving Pi - -- and square roots. The error bound specified in the - -- table takes the sqrt error into account but not the - -- error due to Pi. The Pi error is added in in the - -- radians test below. - - Arcsin_Test_Data : constant Test_Data_Type := ( - -- degrees radians sine error_bound test # - --( 0.0, 0.0, 0.0, 0.0 ), -- 1 - In Exact_Result_Test. - ( 30.0, Pi/6.0, 0.5, 4.0 ), -- 2 - ( 60.0, Pi/3.0, Sqrt3/2.0, 5.0 ), -- 3 - --( 90.0, Pi/2.0, 1.0, 4.0 ), -- 4 - In Exact_Result_Test. - --(-90.0, -Pi/2.0, -1.0, 4.0 ), -- 5 - In Exact_Result_Test. - (-60.0, -Pi/3.0, -Sqrt3/2.0, 5.0 ), -- 6 - (-30.0, -Pi/6.0, -0.5, 4.0 ), -- 7 - ( 45.0, Pi/4.0, Sqrt2/2.0, 5.0 ), -- 8 - (-45.0, -Pi/4.0, -Sqrt2/2.0, 5.0 ) ); -- 9 - - Arccos_Test_Data : constant Test_Data_Type := ( - -- degrees radians cosine error_bound test # - --( 0.0, 0.0, 1.0, 0.0 ), -- 1 - In Exact_Result_Test. - ( 30.0, Pi/6.0, Sqrt3/2.0, 5.0 ), -- 2 - ( 60.0, Pi/3.0, 0.5, 4.0 ), -- 3 - --( 90.0, Pi/2.0, 0.0, 4.0 ), -- 4 - In Exact_Result_Test. - (120.0, 2.0*Pi/3.0, -0.5, 4.0 ), -- 5 - (150.0, 5.0*Pi/6.0, -Sqrt3/2.0, 5.0 ), -- 6 - --(180.0, Pi, -1.0, 4.0 ), -- 7 - In Exact_Result_Test. - ( 45.0, Pi/4.0, Sqrt2/2.0, 5.0 ), -- 8 - (135.0, 3.0*Pi/4.0, -Sqrt2/2.0, 5.0 ) ); -- 9 - - Cycle_Error, - Radian_Error : Real; - begin - for I in Arcsin_Test_Data'Range loop - - -- note exact result requirements A.5.1(38);6.0 and - -- G.2.4(12);6.0 - if Arcsin_Test_Data (I).Error_Bound = 0.0 then - Cycle_Error := 0.0; - Radian_Error := 0.0; - else - Cycle_Error := Arcsin_Test_Data (I).Error_Bound; - -- allow for rounding error in the specification of Pi - Radian_Error := Cycle_Error + 1.0; - end if; - - Check (Arcsin (Arcsin_Test_Data (I).Argument), - Arcsin_Test_Data (I).Radians, - "test" & Integer'Image (I) & - " arcsin(" & - Real'Image (Arcsin_Test_Data (I).Argument) & - ")", - Radian_Error); ---pwb-math Check (Arcsin (Arcsin_Test_Data (I).Argument, 2.0 * Pi), ---pwb-math Arcsin_Test_Data (I).Radians, ---pwb-math "test" & Integer'Image (I) & ---pwb-math " arcsin(" & ---pwb-math Real'Image (Arcsin_Test_Data (I).Argument) & ---pwb-math ", 2pi)", ---pwb-math Cycle_Error); - Check (Arcsin (Arcsin_Test_Data (I).Argument, 360.0), - Arcsin_Test_Data (I).Degrees, - "test" & Integer'Image (I) & - " arcsin(" & - Real'Image (Arcsin_Test_Data (I).Argument) & - ", 360)", - Cycle_Error); - end loop; - - - for I in Arccos_Test_Data'Range loop - - -- note exact result requirements A.5.1(39);6.0 and - -- G.2.4(12);6.0 - if Arccos_Test_Data (I).Error_Bound = 0.0 then - Cycle_Error := 0.0; - Radian_Error := 0.0; - else - Cycle_Error := Arccos_Test_Data (I).Error_Bound; - -- allow for rounding error in the specification of Pi - Radian_Error := Cycle_Error + 1.0; - end if; - - Check (Arccos (Arccos_Test_Data (I).Argument), - Arccos_Test_Data (I).Radians, - "test" & Integer'Image (I) & - " arccos(" & - Real'Image (Arccos_Test_Data (I).Argument) & - ")", - Radian_Error); ---pwb-math Check (Arccos (Arccos_Test_Data (I).Argument, 2.0 * Pi), ---pwb-math Arccos_Test_Data (I).Radians, ---pwb-math "test" & Integer'Image (I) & ---pwb-math " arccos(" & ---pwb-math Real'Image (Arccos_Test_Data (I).Argument) & ---pwb-math ", 2pi)", ---pwb-math Cycle_Error); - Check (Arccos (Arccos_Test_Data (I).Argument, 360.0), - Arccos_Test_Data (I).Degrees, - "test" & Integer'Image (I) & - " arccos(" & - Real'Image (Arccos_Test_Data (I).Argument) & - ", 360)", - Cycle_Error); - end loop; - - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special value test"); - when others => - Report.Failed ("exception in special value test"); - end Special_Value_Test; - - - procedure Check_Exact (Actual, Expected_Low, Expected_High : Real; - Test_Name : String) is - -- If the expected result is not a model number, then Expected_Low is - -- the first machine number less than the (exact) expected - -- result, and Expected_High is the first machine number greater than - -- the (exact) expected result. If the expected result is a model - -- number, Expected_Low = Expected_High = the result. - Model_Expected_Low : Real := Expected_Low; - Model_Expected_High : Real := Expected_High; - begin - -- Calculate the first model number nearest to, but below (or equal) - -- to the expected result: - while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop - -- Try the next machine number lower: - Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0); - end loop; - -- Calculate the first model number nearest to, but above (or equal) - -- to the expected result: - while Real'Model (Model_Expected_High) /= Model_Expected_High loop - -- Try the next machine number higher: - Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0); - end loop; - - if Actual < Model_Expected_Low or Actual > Model_Expected_High then - Accuracy_Error_Reported := True; - if Actual < Model_Expected_Low then - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected low: " & Real'Image (Model_Expected_Low) & - " expected high: " & Real'Image (Model_Expected_High) & - " difference: " & Real'Image (Actual - Expected_Low)); - else - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected low: " & Real'Image (Model_Expected_Low) & - " expected high: " & Real'Image (Model_Expected_High) & - " difference: " & Real'Image (Expected_High - Actual)); - end if; - elsif Verbose then - Report.Comment (Test_Name & " passed"); - end if; - end Check_Exact; - - - procedure Exact_Result_Test is - begin - -- A.5.1(38) - Check_Exact (Arcsin (0.0), 0.0, 0.0, "arcsin(0)"); - Check_Exact (Arcsin (0.0, 45.0), 0.0, 0.0, "arcsin(0,45)"); - - -- A.5.1(39) - Check_Exact (Arccos (1.0), 0.0, 0.0, "arccos(1)"); - Check_Exact (Arccos (1.0, 75.0), 0.0, 0.0, "arccos(1,75)"); - - -- G.2.4(11-13) - Check_Exact (Arcsin (1.0), Half_PI_Low, Half_PI_High, "arcsin(1)"); - Check_Exact (Arcsin (1.0, 360.0), 90.0, 90.0, "arcsin(1,360)"); - - Check_Exact (Arcsin (-1.0), -Half_PI_High, -Half_PI_Low, "arcsin(-1)"); - Check_Exact (Arcsin (-1.0, 360.0), -90.0, -90.0, "arcsin(-1,360)"); - - Check_Exact (Arccos (0.0), Half_PI_Low, Half_PI_High, "arccos(0)"); - Check_Exact (Arccos (0.0, 360.0), 90.0, 90.0, "arccos(0,360)"); - - Check_Exact (Arccos (-1.0), PI_Low, PI_High, "arccos(-1)"); - Check_Exact (Arccos (-1.0, 360.0), 180.0, 180.0, "arccos(-1,360)"); - - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("Exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Arcsin_Taylor_Series_Test is - -- the following range is chosen so that the Taylor series - -- used will produce a result accurate to machine precision. - -- - -- The following formula is used for the Taylor series: - -- TS(x) = x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) + - -- (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] } - -- where xsq = x * x - -- - A : constant := -0.125; - B : constant := 0.125; - X : Real; - Y, Y_Sq : Real; - Actual, Sum, Xm : Real; - -- terms in Taylor series - K : constant Integer := Integer ( - Log ( - Real (Real'Machine_Radix) ** Real'Machine_Mantissa, - 10.0)) + 1; - begin - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - -- make sure there is no error in x-1, x, and x+1 - X := (B - A) * Real (I) / Real (Max_Samples) + A; - - Y := X; - Y_Sq := Y * Y; - Sum := 0.0; - Xm := Real (K + K + 1); - for M in 1 .. K loop - Sum := Y_Sq * (Sum + 1.0/Xm); - Xm := Xm - 2.0; - Sum := Sum * (Xm /(Xm + 1.0)); - end loop; - Sum := Sum * Y; - Actual := Y + Sum; - Sum := (Y - Actual) + Sum; - if not Real'Machine_Rounds then - Actual := Actual + (Sum + Sum); - end if; - - Check (Actual, Arcsin (X), - "Taylor Series test" & Integer'Image (I) & ": arcsin(" & - Real'Image (X) & ") ", - Minimum_Error); - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Arcsin_Taylor_Series_Test" & - " for X=" & Real'Image (X)); - when others => - Report.Failed ("exception in Arcsin_Taylor_Series_Test" & - " for X=" & Real'Image (X)); - end Arcsin_Taylor_Series_Test; - - - - procedure Arccos_Taylor_Series_Test is - -- the following range is chosen so that the Taylor series - -- used will produce a result accurate to machine precision. - -- - -- The following formula is used for the Taylor series: - -- TS(x) = x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) + - -- (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] } - -- arccos(x) = pi/2 - TS(x) - A : constant := -0.125; - B : constant := 0.125; - C1, C2 : Real; - X : Real; - Y, Y_Sq : Real; - Actual, Sum, Xm, S : Real; - -- terms in Taylor series - K : constant Integer := Integer ( - Log ( - Real (Real'Machine_Radix) ** Real'Machine_Mantissa, - 10.0)) + 1; - begin - if Real'Digits > 23 then - -- constants in this section only accurate to 23 digits - Error_Low_Bound := 0.00000_00000_00000_00000_001; - Report.Comment ("arctan accuracy checked to 23 digits"); - end if; - - -- C1 + C2 equals Pi/2 accurate to 23 digits - if Real'Machine_Radix = 10 then - C1 := 1.57; - C2 := 7.9632679489661923132E-4; - else - C1 := 201.0 / 128.0; - C2 := 4.8382679489661923132E-4; - end if; - - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - -- make sure there is no error in x-1, x, and x+1 - X := (B - A) * Real (I) / Real (Max_Samples) + A; - - Y := X; - Y_Sq := Y * Y; - Sum := 0.0; - Xm := Real (K + K + 1); - for M in 1 .. K loop - Sum := Y_Sq * (Sum + 1.0/Xm); - Xm := Xm - 2.0; - Sum := Sum * (Xm /(Xm + 1.0)); - end loop; - Sum := Sum * Y; - - -- at this point we have arcsin(x). - -- We compute arccos(x) = pi/2 - arcsin(x). - -- The following code segment is translated directly from - -- the CELEFUNT FORTRAN implementation - - S := C1 + C2; - Sum := ((C1 - S) + C2) - Sum; - Actual := S + Sum; - Sum := ((S - Actual) + Sum) - Y; - S := Actual; - Actual := S + Sum; - Sum := (S - Actual) + Sum; - - if not Real'Machine_Rounds then - Actual := Actual + (Sum + Sum); - end if; - - Check (Actual, Arccos (X), - "Taylor Series test" & Integer'Image (I) & ": arccos(" & - Real'Image (X) & ") ", - Minimum_Error); - - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - exit when Accuracy_Error_Reported; - end loop; - Error_Low_Bound := 0.0; -- reset - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Arccos_Taylor_Series_Test" & - " for X=" & Real'Image (X)); - when others => - Report.Failed ("exception in Arccos_Taylor_Series_Test" & - " for X=" & Real'Image (X)); - end Arccos_Taylor_Series_Test; - - - - procedure Identity_Test is - -- test the identity arcsin(-x) = -arcsin(x) - -- range chosen to be most of the valid range of the argument. - A : constant := -0.999; - B : constant := 0.999; - X : Real; - begin - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - -- make sure there is no error in x-1, x, and x+1 - X := (B - A) * Real (I) / Real (Max_Samples) + A; - - Check (Arcsin(-X), -Arcsin (X), - "Identity test" & Integer'Image (I) & ": arcsin(" & - Real'Image (X) & ") ", - 8.0); -- 2 arcsin evaluations => twice the error bound - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - end loop; - end Identity_Test; - - - procedure Exception_Test is - X1, X2 : Real := 0.0; - begin - begin - X1 := Arcsin (1.1); - Report.Failed ("no exception for Arcsin (1.1)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error instead of " & - "Argument_Error for Arcsin (1.1)"); - when Ada.Numerics.Argument_Error => - null; -- expected result - when others => - Report.Failed ("wrong exception for Arcsin(1.1)"); - end; - - begin - X2 := Arccos (-1.1); - Report.Failed ("no exception for Arccos (-1.1)"); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error instead of " & - "Argument_Error for Arccos (-1.1)"); - when Ada.Numerics.Argument_Error => - null; -- expected result - when others => - Report.Failed ("wrong exception for Arccos(-1.1)"); - end; - - - -- optimizer thwarting - if Report.Ident_Bool (False) then - Report.Comment (Real'Image (X1 + X2)); - end if; - end Exception_Test; - - - procedure Do_Test is - begin - Special_Value_Test; - Exact_Result_Test; - Arcsin_Taylor_Series_Test; - Arccos_Taylor_Series_Test; - Identity_Test; - Exception_Test; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - -- These expressions must be truly static, which is why we have to do them - -- outside of the generic, and we use the named numbers. Note that we know - -- that PI is not a machine number (it is irrational), and it should be - -- represented to more digits than supported by the target machine. - Float_Half_PI_Low : constant := Float'Adjacent(PI/2.0, 0.0); - Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0); - Float_PI_Low : constant := Float'Adjacent(PI, 0.0); - Float_PI_High : constant := Float'Adjacent(PI, 10.0); - package Float_Check is new Generic_Check (Float, - Half_PI_Low => Float_Half_PI_Low, - Half_PI_High => Float_Half_PI_High, - PI_Low => Float_PI_Low, - PI_High => Float_PI_High); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - A_Long_Float_Half_PI_Low : constant := A_Long_Float'Adjacent(PI/2.0, 0.0); - A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0); - A_Long_Float_PI_Low : constant := A_Long_Float'Adjacent(PI, 0.0); - A_Long_Float_PI_High : constant := A_Long_Float'Adjacent(PI, 10.0); - package A_Long_Float_Check is new Generic_Check (A_Long_Float, - Half_PI_Low => A_Long_Float_Half_PI_Low, - Half_PI_High => A_Long_Float_Half_PI_High, - PI_Low => A_Long_Float_PI_Low, - PI_High => A_Long_Float_PI_High); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2015", - "Check the accuracy of the ARCSIN and ARCCOS 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 CXG2015; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a deleted file mode 100644 index 832b118224a..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a +++ /dev/null @@ -1,482 +0,0 @@ --- CXG2016.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 ARCTAN function returns a --- result that is within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Exception checks. --- --- 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: --- 19 Mar 96 SAIC Initial release for 2.1 --- 30 APR 96 SAIC Fixed optimization issue --- 17 AUG 96 SAIC Incorporated Reviewer's suggestions. --- 12 OCT 96 SAIC Incorporated Reviewer's suggestions. --- 02 DEC 97 EDS Remove procedure Identity_1_Test and calls to --- procedure. --- 29 JUN 98 EDS Replace -0.0 with call to ImpDef.Annex_G.Negative_Zero --- 28 APR 99 RLB Replaced comma accidentally deleted in above change. --- 15 DEC 99 RLB Added model range checking to "exact" results, --- in order to avoid too strictly requiring a specific --- result. ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -with Impdef.Annex_G; -procedure CXG2016 is - Verbose : constant Boolean := False; - Max_Samples : constant := 1000; - - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; - - Pi : constant := Ada.Numerics.Pi; - - generic - type Real is digits <>; - Half_PI_Low : in Real; -- The machine number closest to, but not greater - -- than PI/2.0. - Half_PI_High : in Real;-- The machine number closest to, but not less - -- than PI/2.0. - PI_Low : in Real; -- The machine number closest to, but not greater - -- than PI. - PI_High : in Real; -- The machine number closest to, but not less - -- than PI. - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - - function Arctan (Y : Real; - X : Real := 1.0) return Real renames - Elementary_Functions.Arctan; - function Arctan (Y : Real; - X : Real := 1.0; - Cycle : Real) return Real renames - Elementary_Functions.Arctan; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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; - - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Special_Value_Test is - -- If eta is very small, arctan(x + eta) ~= arctan(x) + eta/(1+x*x). - -- - -- For tests 4 and 5, there is an error of 4.0ME for arctan + an - -- additional error of 1.0ME because pi is not exact for a total of 5.0ME. - -- - -- In test 3 there is the error for pi plus an additional error - -- of (1.0ME)/4 since sqrt3 is not exact, for a total of 5.25ME. - -- - -- In test 2 there is the error for pi plus an additional error - -- of (3/4)(1.0ME) since sqrt3 is not exact, for a total of 5.75ME. - - - type Data_Point is - record - Degrees, - Radians, - Tangent, - Allowed_Error : Real; - end record; - - type Test_Data_Type is array (Positive range <>) of Data_Point; - - -- the values in the following table only involve static - -- expressions so no additional loss of precision occurs. - Test_Data : constant Test_Data_Type := ( - -- degrees radians tangent error test # - ( 0.0, 0.0, 0.0, 4.0 ), -- 1 - ( 30.0, Pi/6.0, Sqrt3/3.0, 5.75), -- 2 - ( 60.0, Pi/3.0, Sqrt3, 5.25), -- 3 - ( 45.0, Pi/4.0, 1.0, 5.0 ), -- 4 - (-45.0, -Pi/4.0, -1.0, 5.0 ) ); -- 5 - - begin - for I in Test_Data'Range loop - Check (Arctan (Test_Data (I).Tangent), - Test_Data (I).Radians, - "special value test" & Integer'Image (I) & - " arctan(" & - Real'Image (Test_Data (I).Tangent) & - ")", - Test_Data (I).Allowed_Error); - Check (Arctan (Test_Data (I).Tangent, Cycle => 360.0), - Test_Data (I).Degrees, - "special value test" & Integer'Image (I) & - " arctan(" & - Real'Image (Test_Data (I).Tangent) & - ", cycle=>360)", - Test_Data (I).Allowed_Error); - end loop; - - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special value test"); - when others => - Report.Failed ("exception in special value test"); - end Special_Value_Test; - - - - procedure Check_Exact (Actual, Expected_Low, Expected_High : Real; - Test_Name : String) is - -- If the expected result is not a model number, then Expected_Low is - -- the first machine number less than the (exact) expected - -- result, and Expected_High is the first machine number greater than - -- the (exact) expected result. If the expected result is a model - -- number, Expected_Low = Expected_High = the result. - Model_Expected_Low : Real := Expected_Low; - Model_Expected_High : Real := Expected_High; - begin - -- Calculate the first model number nearest to, but below (or equal) - -- to the expected result: - while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop - -- Try the next machine number lower: - Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0); - end loop; - -- Calculate the first model number nearest to, but above (or equal) - -- to the expected result: - while Real'Model (Model_Expected_High) /= Model_Expected_High loop - -- Try the next machine number higher: - Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0); - end loop; - - if Actual < Model_Expected_Low or Actual > Model_Expected_High then - Accuracy_Error_Reported := True; - if Actual < Model_Expected_Low then - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected low: " & Real'Image (Model_Expected_Low) & - " expected high: " & Real'Image (Model_Expected_High) & - " difference: " & Real'Image (Actual - Expected_Low)); - else - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected low: " & Real'Image (Model_Expected_Low) & - " expected high: " & Real'Image (Model_Expected_High) & - " difference: " & Real'Image (Expected_High - Actual)); - end if; - elsif Verbose then - Report.Comment (Test_Name & " passed"); - end if; - end Check_Exact; - - - procedure Exact_Result_Test is - begin - -- A.5.1(40);6.0 - Check_Exact (Arctan (0.0, 1.0), 0.0, 0.0, "arctan(0,1)"); - Check_Exact (Arctan (0.0, 1.0, 27.0), 0.0, 0.0, "arctan(0,1,27)"); - - -- G.2.4(11-13);6.0 - - Check_Exact (Arctan (1.0, 0.0), Half_PI_Low, Half_PI_High, - "arctan(1,0)"); - Check_Exact (Arctan (1.0, 0.0, 360.0), 90.0, 90.0, "arctan(1,0,360)"); - - Check_Exact (Arctan (-1.0, 0.0), -Half_PI_High, -Half_PI_Low, - "arctan(-1,0)"); - Check_Exact (Arctan (-1.0, 0.0, 360.0), -90.0, -90.0, - "arctan(-1,0,360)"); - - if Real'Signed_Zeros then - Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(+0,-1)"); - Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0, - "arctan(+0,-1,360)"); - Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0), - -PI_High, -PI_Low, "arctan(-0,-1)"); - Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0, - 360.0), -180.0, -180.0, "arctan(-0,-1,360)"); - else - Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(0,-1)"); - Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0, - "arctan(0,-1,360)"); - end if; - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("Exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Taylor_Series_Test is - -- This test checks the Arctan by using a taylor series expansion that - -- will produce a result accurate to 19 decimal digits for - -- the range under test. - -- - -- The maximum relative error bound for this test is - -- 4 for the arctan operation and 2 for the Taylor series - -- for a total of 6 * Model_Epsilon - - A : constant := -1.0/16.0; - B : constant := 1.0/16.0; - X : Real; - Actual, Expected : Real; - Sum, Em, X_Squared : Real; - begin - if Real'Digits > 19 then - -- Taylor series calculation produces result accurate to 19 - -- digits. If type being tested has more digits then set - -- the error low bound to account for this. - -- The error low bound is conservatively set to 6*10**-19 - Error_Low_Bound := 0.00000_00000_00000_0006; - Report.Comment ("arctan accuracy checked to 19 digits"); - end if; - - Accuracy_Error_Reported := False; -- reset - for I in 0..Max_Samples loop - X := (B - A) * Real (I) / Real (Max_Samples) + A; - X_Squared := X * X; - Em := 17.0; - Sum := X_Squared / Em; - - for II in 1 .. 7 loop - Em := Em - 2.0; - Sum := (1.0 / Em - Sum) * X_Squared; - end loop; - Sum := -X * Sum; - Expected := X + Sum; - Sum := (X - Expected) + Sum; - if not Real'Machine_Rounds then - Expected := Expected + (Sum + Sum); - end if; - - Actual := Arctan (X); - - Check (Actual, Expected, - "Taylor_Series_Test " & Integer'Image (I) & ": arctan(" & - Real'Image (X) & ") ", - 6.0); - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - Error_Low_Bound := 0.0; -- reset - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Taylor_Series_Test"); - when others => - Report.Failed ("exception in Taylor_Series_Test"); - end Taylor_Series_Test; - - - procedure Exception_Test is - X1, X2, X3 : Real := 0.0; - begin - - begin -- A.5.1(20);6.0 - X1 := Arctan(0.0, Cycle => 0.0); - Report.Failed ("no exception for cycle = 0.0"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for cycle = 0.0"); - end; - - begin -- A.5.1(20);6.0 - X2 := Arctan (0.0, Cycle => -1.0); - Report.Failed ("no exception for cycle < 0.0"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for cycle < 0.0"); - end; - - begin -- A.5.1(25);6.0 - X3 := Arctan (0.0, 0.0); - Report.Failed ("no exception for arctan(0,0)"); - exception - when Ada.Numerics.Argument_Error => null; - when others => - Report.Failed ("wrong exception for arctan(0,0)"); - end; - - -- optimizer thwarting - if Report.Ident_Bool (False) then - Report.Comment (Real'Image (X1 + X2 + X3)); - end if; - end Exception_Test; - - - procedure Do_Test is - begin - Special_Value_Test; - Exact_Result_Test; - Taylor_Series_Test; - Exception_Test; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - -- These expressions must be truly static, which is why we have to do them - -- outside of the generic, and we use the named numbers. Note that we know - -- that PI is not a machine number (it is irrational), and it should be - -- represented to more digits than supported by the target machine. - Float_Half_PI_Low : constant := Float'Adjacent(PI/2.0, 0.0); - Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0); - Float_PI_Low : constant := Float'Adjacent(PI, 0.0); - Float_PI_High : constant := Float'Adjacent(PI, 10.0); - package Float_Check is new Generic_Check (Float, - Half_PI_Low => Float_Half_PI_Low, - Half_PI_High => Float_Half_PI_High, - PI_Low => Float_PI_Low, - PI_High => Float_PI_High); - - -- check the Floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - A_Long_Float_Half_PI_Low : constant := A_Long_Float'Adjacent(PI/2.0, 0.0); - A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0); - A_Long_Float_PI_Low : constant := A_Long_Float'Adjacent(PI, 0.0); - A_Long_Float_PI_High : constant := A_Long_Float'Adjacent(PI, 10.0); - package A_Long_Float_Check is new Generic_Check (A_Long_Float, - Half_PI_Low => A_Long_Float_Half_PI_Low, - Half_PI_High => A_Long_Float_Half_PI_High, - PI_Low => A_Long_Float_PI_Low, - PI_High => A_Long_Float_PI_High); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2016", - "Check the accuracy of the ARCTAN function"); - - 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 CXG2016; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a deleted file mode 100644 index 50add975f7f..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a +++ /dev/null @@ -1,296 +0,0 @@ --- CXG2017.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 TANH function returns --- a result that is within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks that use an identity for determining the result. --- --- 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: --- 20 Mar 96 SAIC Initial release for 2.1 --- 17 Aug 96 SAIC Incorporated reviewer comments. --- 03 Jun 98 EDS Add parens to remove the potential for overflow. --- Remove the invocation of Identity_Test that checks --- Tanh values that are too close to zero for the --- test's error bounds. ---! - --- --- References: --- --- Software Manual for the Elementary Functions --- William J. Cody, Jr. and William Waite --- Prentice-Hall, 1980 --- --- CRC Standard Mathematical Tables --- 23rd Edition --- --- Implementation and Testing of Function Software --- W. J. Cody --- Problems and Methodologies in Mathematical Software Production --- editors P. C. Messina and A. Murli --- Lecture Notes in Computer Science Volume 142 --- Springer Verlag, 1982 --- - -with System; -with Report; -with Ada.Numerics.Generic_Elementary_Functions; -procedure CXG2017 is - Verbose : constant Boolean := False; - Max_Samples : constant := 1000; - - E : constant := Ada.Numerics.E; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Elementary_Functions is new - Ada.Numerics.Generic_Elementary_Functions (Real); - - function Tanh (X : Real) return Real renames - Elementary_Functions.Tanh; - - function Log (X : Real) return Real renames - Elementary_Functions.Log; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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_Small instead - -- of Model_Epsilon and Expected. - Rel_Error := MRE * abs Expected * Real'Model_Epsilon; - Abs_Error := MRE * Real'Model_Small; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Special_Value_Test is - -- In the following tests the expected result is accurate - -- to the machine precision so the minimum guaranteed error - -- bound can be used. - Minimum_Error : constant := 8.0; - E2 : constant := E * E; - begin - Check (Tanh (1.0), - (E - 1.0 / E) / (E + 1.0 / E), - "tanh(1)", - Minimum_Error); - Check (Tanh (2.0), - (E2 - 1.0 / E2) / (E2 + 1.0 / E2), - "tanh(2)", - Minimum_Error); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special value test"); - when others => - Report.Failed ("exception in special value test"); - end Special_Value_Test; - - - - procedure Exact_Result_Test is - No_Error : constant := 0.0; - begin - -- A.5.1(38);6.0 - Check (Tanh (0.0), 0.0, "tanh(0)", No_Error); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Identity_Test (A, B : Real) is - -- For this test we use the identity - -- TANH(u+v) = [TANH(u) + TANH(v)] / [1 + TANH(u)*TANH(v)] - -- which is transformed to - -- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C] - -- where C = TANH(1/8) and y = x - 1/8 - -- - -- see Cody pg 248-249 for details on the error analysis. - -- The net result is a relative error bound of 16 * Model_Epsilon. - -- - -- The second part of this test checks the identity - -- TANH(-x) = -TANH(X) - - X, Y : Real; - Actual1, Actual2 : Real; - C : constant := 1.2435300177159620805e-1; - begin - if Real'Digits > 20 then - -- constant C is accurate to 20 digits. Set the low bound - -- on the error to 16*10**-20 - Error_Low_Bound := 0.00000_00000_00000_00016; - Report.Comment ("tanh accuracy checked to 20 digits"); - end if; - - Accuracy_Error_Reported := False; -- reset - for I in 1..Max_Samples loop - X := (B - A) * (Real (I) / Real (Max_Samples)) + A; - Actual1 := Tanh(X); - - -- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C] - Y := X - (1.0 / 8.0); - Actual2 := (Tanh (Y) + C) / (1.0 + Tanh(Y) * C); - - Check (Actual1, Actual2, - "Identity_1_Test " & Integer'Image (I) & ": tanh(" & - Real'Image (X) & ") ", - 16.0); - - -- TANH(-x) = -TANH(X) - Actual2 := Tanh(-X); - Check (-Actual1, Actual2, - "Identity_2_Test " & Integer'Image (I) & ": tanh(" & - Real'Image (X) & ") ", - 16.0); - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - - end loop; - Error_Low_Bound := 0.0; -- reset - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Identity_Test" & - " for X=" & Real'Image (X)); - when others => - Report.Failed ("exception in Identity_Test" & - " for X=" & Real'Image (X)); - end Identity_Test; - - - - procedure Do_Test is - begin - Special_Value_Test; - Exact_Result_Test; - -- cover a large range - Identity_Test (1.0, Real'Safe_Last); - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2017", - "Check the accuracy of the TANH function"); - - 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 CXG2017; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a deleted file mode 100644 index be4f1a82faf..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a +++ /dev/null @@ -1,355 +0,0 @@ --- CXG2018.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 complex EXP function returns --- a result that is within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check complex numbers based upon --- both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks that use an identity for determining the result. --- --- 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: --- 21 Mar 96 SAIC Initial release for 2.1 --- 17 Aug 96 SAIC Incorporated reviewer comments. --- 27 Aug 99 RLB Repair on the error result of checks. --- 02 Apr 03 RLB Added code to discard excess precision in the --- construction of the test value for the --- Identity_Test. --- ---! - --- --- References: --- --- W. J. Cody --- CELEFUNT: A Portable Test Package for Complex Elementary Functions --- Algorithm 714, Collected Algorithms from ACM. --- Published in Transactions On Mathematical Software, --- Vol. 19, No. 1, March, 1993, pp. 1-21. --- --- CRC Standard Mathematical Tables --- 23rd Edition --- - -with System; -with Report; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Generic_Complex_Elementary_Functions; -procedure CXG2018 is - Verbose : constant Boolean := False; - -- Note that Max_Samples is the number of samples taken in - -- both the real and imaginary directions. Thus, for Max_Samples - -- of 100 the number of values checked is 10000. - Max_Samples : constant := 100; - - E : constant := Ada.Numerics.E; - Pi : constant := Ada.Numerics.Pi; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Complex_Type is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Type; - - package CEF is new - Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type); - - function Exp (X : Complex) return Complex renames CEF.Exp; - function Exp (X : Imaginary) return Complex renames CEF.Exp; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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_Small instead - -- of Model_Epsilon and Expected. - Rel_Error := MRE * abs Expected * Real'Model_Epsilon; - Abs_Error := MRE * Real'Model_Small; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Check (Actual, Expected : Complex; - Test_Name : String; - MRE : Real) is - begin - Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE); - Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE); - end Check; - - - procedure Special_Value_Test is - -- In the following tests the expected result is accurate - -- to the machine precision so the minimum guaranteed error - -- bound can be used. - -- - -- The error bounds given assumed z is exact. When using - -- pi there is an extra error of 1.0ME. - -- The pi inside the exp call requires that the complex - -- component have an extra error allowance of 1.0*angle*ME. - -- Thus for pi/2,the Minimum_Error_I is - -- (2.0 + 1.0(pi/2))ME <= 3.6ME. - -- For pi, it is (2.0 + 1.0*pi)ME <= 5.2ME, - -- and for 2pi, it is (2.0 + 1.0(2pi))ME <= 8.3ME. - - -- The addition of 1 or i to a result is so that neither of - -- the components of an expected result is 0. This is so - -- that a reasonable relative error is allowed. - Minimum_Error_C : constant := 7.0; -- for exp(Complex) - Minimum_Error_I : constant := 2.0; -- for exp(Imaginary) - begin - Check (Exp (1.0 + 0.0*i) + i, - E + i, - "exp(1+0i)", - Minimum_Error_C); - Check (Exp ((Pi / 2.0) * i) + 1.0, - 1.0 + 1.0*i, - "exp(pi/2*i)", - 3.6); - Check (Exp (Pi * i) + i, - -1.0 + 1.0*i, - "exp(pi*i)", - 5.2); - Check (Exp (Pi * 2.0 * i) + i, - 1.0 + i, - "exp(2pi*i)", - 8.3); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special value test"); - when others => - Report.Failed ("exception in special value test"); - end Special_Value_Test; - - - - procedure Exact_Result_Test is - No_Error : constant := 0.0; - begin - -- G.1.2(36);6.0 - Check (Exp(0.0 + 0.0*i), 1.0 + 0.0 * i, "exp(0+0i)", No_Error); - Check (Exp( 0.0*i), 1.0 + 0.0 * i, "exp(0i)", No_Error); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Identity_Test (A, B : Real) is - -- For this test we use the identity - -- Exp(Z) = Exp(Z-W) * Exp (W) - -- where W = (1+i)/16 - -- - -- The second part of this test checks the identity - -- Exp(Z) * Exp(-Z) = 1 - -- - - X, Y : Complex; - Actual1, Actual2 : Complex; - W : constant Complex := (0.0625, 0.0625); - -- the following constant was taken from the CELEFUNC EXP test. - -- This is the value EXP(W) - 1 - C : constant Complex := (6.2416044877018563681e-2, - 6.6487597751003112768e-2); - begin - if Real'Digits > 20 then - -- constant ExpW is accurate to 20 digits. - -- The low bound is 19 * 10**-20 - Error_Low_Bound := 0.00000_00000_00019; - Report.Comment ("complex exp accuracy checked to 20 digits"); - end if; - - Accuracy_Error_Reported := False; -- reset - for II in 1..Max_Samples loop - X.Re := Real'Machine ((B - A) * Real (II) / Real (Max_Samples) - + A); - for J in 1..Max_Samples loop - X.Im := Real'Machine ((B - A) * Real (J) / Real (Max_Samples) - + A); - - Actual1 := Exp(X); - - -- Exp(X) = Exp(X-W) * Exp (W) - -- = Exp(X-W) * (1 - (1-Exp(W)) - -- = Exp(X-W) * (1 + (Exp(W) - 1)) - -- = Exp(X-W) * (1 + C) - Y := X - W; - Actual2 := Exp(Y); - Actual2 := Actual2 + Actual2 * C; - - Check (Actual1, Actual2, - "Identity_1_Test " & Integer'Image (II) & - Integer'Image (J) & ": Exp((" & - Real'Image (X.Re) & ", " & - Real'Image (X.Im) & ")) ", - 20.0); -- 2 exp and 1 multiply and 1 add = 2*7+1*5+1 - -- Note: The above is not strictly correct, as multiply - -- has a box error, rather than a relative error. - -- Supposedly, the interval is chosen to avoid the need - -- to worry about this. - - -- Exp(X) * Exp(-X) + i = 1 + i - -- The addition of i is to allow a reasonable relative - -- error in the imaginary part - Actual2 := (Actual1 * Exp(-X)) + i; - Check (Actual2, (1.0, 1.0), - "Identity_2_Test " & Integer'Image (II) & - Integer'Image (J) & ": Exp((" & - Real'Image (X.Re) & ", " & - Real'Image (X.Im) & ")) ", - 20.0); -- 2 exp and 1 multiply and one add = 2*7+1*5+1 - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - end loop; - end loop; - Error_Low_Bound := 0.0; - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Identity_Test" & - " for X=(" & Real'Image (X.Re) & - ", " & Real'Image (X.Im) & ")"); - when others => - Report.Failed ("exception in Identity_Test" & - " for X=(" & Real'Image (X.Re) & - ", " & Real'Image (X.Im) & ")"); - end Identity_Test; - - - - procedure Do_Test is - begin - Special_Value_Test; - Exact_Result_Test; - -- test regions where we can avoid cancellation error problems - -- See Cody page 10. - Identity_Test (0.0625, 1.0); - Identity_Test (15.0, 17.0); - Identity_Test (1.625, 3.0); - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2018", - "Check the accuracy of the complex EXP function"); - - 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 CXG2018; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a deleted file mode 100644 index 0a4dddcc906..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a +++ /dev/null @@ -1,338 +0,0 @@ --- CXG2019.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 complex LOG function returns --- a result that is within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check complex numbers based upon --- both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks that use an identity for determining the result. --- Exception conditions. --- --- 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: --- 22 Mar 96 SAIC Initial release for 2.1 --- ---! - --- --- References: --- --- W. J. Cody --- CELEFUNT: A Portable Test Package for Complex Elementary Functions --- Algorithm 714, Collected Algorithms from ACM. --- Published in Transactions On Mathematical Software, --- Vol. 19, No. 1, March, 1993, pp. 1-21. --- --- CRC Standard Mathematical Tables --- 23rd Edition --- - -with System; -with Report; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Generic_Complex_Elementary_Functions; -procedure CXG2019 is - Verbose : constant Boolean := False; - -- Note that Max_Samples is the number of samples taken in - -- both the real and imaginary directions. Thus, for Max_Samples - -- of 100 the number of values checked is 10000. - Max_Samples : constant := 100; - - E : constant := Ada.Numerics.E; - Pi : constant := Ada.Numerics.Pi; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Complex_Type is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Type; - - package CEF is new - Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type); - - function Log (X : Complex) return Complex renames CEF.Log; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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_Small 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 - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Check (Actual, Expected : Complex; - Test_Name : String; - MRE : Real) is - begin - Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE); - Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE); - end Check; - - - procedure Special_Value_Test is - -- In the following tests the expected result is accurate - -- to the machine precision so the minimum guaranteed error - -- bound can be used if the argument is exact. - -- - -- When using pi there is an extra error of 1.0ME. - -- Although the real component has an error bound of 13.0, - -- the complex component must take into account this error - -- in the value for Pi. - -- - -- One or i is added to the actual and expected results in - -- order to prevent the expected result from having a - -- real or imaginary part of 0. This is to allow a reasonable - -- relative error for that component. - Minimum_Error : constant := 13.0; - begin - Check (1.0 + Log (0.0 + i), - 1.0 + Pi / 2.0 * i, - "1+log(0+i)", - Minimum_Error + 1.0); - Check (1.0 + Log ((-1.0, 0.0)), - 1.0 + (Pi * i), - "log(-1+0i)+1 ", - Minimum_Error + 1.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special value test"); - when others => - Report.Failed ("exception in special value test"); - end Special_Value_Test; - - - - procedure Exact_Result_Test is - No_Error : constant := 0.0; - begin - -- G.1.2(37);6.0 - Check (Log(1.0 + 0.0*i), 0.0 + 0.0 * i, "log(1+0i)", No_Error); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Identity_Test (RA, RB, IA, IB : Real) is - -- Tests an identity over a range of values specified - -- by the 4 parameters. RA and RB denote the range for the - -- real part while IA and IB denote the range for the - -- imaginary part. - -- - -- For this test we use the identity - -- Log(Z*Z) = 2 * Log(Z) - -- - - Scale : Real := Real (Real'Machine_Radix) ** (Real'Mantissa / 2 + 4); - W, X, Y, Z : Real; - CX, CY : Complex; - Actual1, Actual2 : Complex; - begin - Accuracy_Error_Reported := False; -- reset - for II in 1..Max_Samples loop - X := (RB - RA) * Real (II) / Real (Max_Samples) + RA; - for J in 1..Max_Samples loop - Y := (IB - IA) * Real (J) / Real (Max_Samples) + IA; - - -- purify the arguments to minimize roundoff error. - -- We construct the values so that the products X*X, - -- Y*Y, and X*Y are all exact machine numbers. - -- See Cody page 7 and CELEFUNT code. - Z := X * Scale; - W := Z + X; - X := W - Z; - Z := Y * Scale; - W := Z + Y; - Y := W - Z; - CX := Compose_From_Cartesian(X,Y); - Z := X*X - Y*Y; - W := X*Y; - CY := Compose_From_Cartesian(Z,W+W); - - -- The arguments are now ready so on with the - -- identity computation. - Actual1 := Log(CX); - - Actual2 := Log(CY) * 0.5; - - Check (Actual1, Actual2, - "Identity_1_Test " & Integer'Image (II) & - Integer'Image (J) & ": Log((" & - Real'Image (CX.Re) & ", " & - Real'Image (CX.Im) & ")) ", - 26.0); -- 2 logs = 2*13. no error from this multiply - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - end loop; - end loop; - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Identity_Test" & - " for X=(" & Real'Image (X) & - ", " & Real'Image (X) & ")"); - when others => - Report.Failed ("exception in Identity_Test" & - " for X=(" & Real'Image (X) & - ", " & Real'Image (X) & ")"); - end Identity_Test; - - - procedure Exception_Test is - -- Check that log((0,0)) causes constraint_error. - -- G.1.2(29); - - X : Complex := (0.0, 0.0); - begin - if not Real'Machine_Overflows then - -- not applicable: G.1.2(28);6.0 - return; - end if; - - begin - X := Log ((0.0, 0.0)); - Report.Failed ("exception not raised for log(0,0)"); - exception - when Constraint_Error => null; -- ok - when others => - Report.Failed ("wrong exception raised for log(0,0)"); - end; - - -- optimizer thwarting - if Report.Ident_Bool(False) then - Report.Comment (Real'Image (X.Re + X.Im)); - end if; - end Exception_Test; - - - procedure Do_Test is - begin - Special_Value_Test; - Exact_Result_Test; - -- test regions that do not include the unit circle so that - -- the real part of LOG(Z) does not vanish - -- See Cody page 9. - Identity_Test ( 2.0, 10.0, 0.0, 10.0); - Identity_Test (1000.0, 2000.0, -4000.0, -1000.0); - Identity_Test (Real'Model_Epsilon, 0.25, - -0.25, -Real'Model_Epsilon); - Exception_Test; - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2019", - "Check the accuracy of the complex LOG function"); - - 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 CXG2019; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a deleted file mode 100644 index 1aed4ca5735..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a +++ /dev/null @@ -1,351 +0,0 @@ --- CXG2020.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 complex SQRT function returns --- a result that is within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check complex numbers based upon --- both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks that use an identity for determining the result. --- --- 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: --- 24 Mar 96 SAIC Initial release for 2.1 --- 17 Aug 96 SAIC Incorporated reviewer comments. --- 03 Jun 98 EDS Added parens to ensure that the expression is not --- evaluated by multiplying its two large terms --- together and overflowing. ---! - --- --- References: --- --- W. J. Cody --- CELEFUNT: A Portable Test Package for Complex Elementary Functions --- Algorithm 714, Collected Algorithms from ACM. --- Published in Transactions On Mathematical Software, --- Vol. 19, No. 1, March, 1993, pp. 1-21. --- --- CRC Standard Mathematical Tables --- 23rd Edition --- - -with System; -with Report; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Generic_Complex_Elementary_Functions; -procedure CXG2020 is - Verbose : constant Boolean := False; - -- Note that Max_Samples is the number of samples taken in - -- both the real and imaginary directions. Thus, for Max_Samples - -- of 100 the number of values checked is 10000. - Max_Samples : constant := 100; - - E : constant := Ada.Numerics.E; - Pi : constant := Ada.Numerics.Pi; - - -- CRC Standard Mathematical Tables; 23rd Edition; pg 738 - Sqrt2 : constant := - 1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695; - Sqrt3 : constant := - 1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Complex_Type is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Type; - - package CEF is new - Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type); - - function Sqrt (X : Complex) return Complex renames CEF.Sqrt; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real) is - Max_Error : Real; - Rel_Error : Real; - Abs_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 - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed"); - end if; - end if; - end Check; - - - procedure Check (Actual, Expected : Complex; - Test_Name : String; - MRE : Real) is - begin - Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE); - Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE); - end Check; - - - procedure Special_Value_Test is - -- In the following tests the expected result is accurate - -- to the machine precision so the minimum guaranteed error - -- bound can be used if the argument is exact. - -- - -- One or i is added to the actual and expected results in - -- order to prevent the expected result from having a - -- real or imaginary part of 0. This is to allow a reasonable - -- relative error for that component. - Minimum_Error : constant := 6.0; - Z1, Z2 : Complex; - begin - Check (Sqrt(9.0+0.0*i) + i, - 3.0+1.0*i, - "sqrt(9+0i)+i", - Minimum_Error); - Check (Sqrt (-2.0 + 0.0 * i) + 1.0, - 1.0 + Sqrt2 * i, - "sqrt(-2)+1 ", - Minimum_Error); - - -- make sure no exception occurs when taking the sqrt of - -- very large and very small values. - - Z1 := (Real'Safe_Last * 0.9, Real'Safe_Last * 0.9); - Z2 := Sqrt (Z1); - begin - Check (Z2 * Z2, - Z1, - "sqrt((big,big))", - Minimum_Error + 5.0); -- +5 for multiply - exception - when others => - Report.Failed ("unexpected exception in sqrt((big,big))"); - end; - - Z1 := (Real'Model_Epsilon * 10.0, Real'Model_Epsilon * 10.0); - Z2 := Sqrt (Z1); - begin - Check (Z2 * Z2, - Z1, - "sqrt((little,little))", - Minimum_Error + 5.0); -- +5 for multiply - exception - when others => - Report.Failed ("unexpected exception in " & - "sqrt((little,little))"); - end; - - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special value test"); - when others => - Report.Failed ("exception in special value test"); - end Special_Value_Test; - - - - procedure Exact_Result_Test is - No_Error : constant := 0.0; - begin - -- G.1.2(36);6.0 - Check (Sqrt(0.0 + 0.0*i), 0.0 + 0.0 * i, "sqrt(0+0i)", No_Error); - - -- G.1.2(37);6.0 - Check (Sqrt(1.0 + 0.0*i), 1.0 + 0.0 * i, "sqrt(1+0i)", No_Error); - - -- G.1.2(38-39);6.0 - Check (Sqrt(-1.0 + 0.0*i), 0.0 + 1.0 * i, "sqrt(-1+0i)", No_Error); - - -- G.1.2(40);6.0 - if Real'Signed_Zeros then - Check (Sqrt(-1.0-0.0*i), 0.0 - 1.0 * i, "sqrt(-1-0i)", No_Error); - end if; - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Identity_Test (RA, RB, IA, IB : Real) is - -- Tests an identity over a range of values specified - -- by the 4 parameters. RA and RB denote the range for the - -- real part while IA and IB denote the range for the - -- imaginary part of the result. - -- - -- For this test we use the identity - -- Sqrt(Z*Z) = Z - -- - - Scale : Real := Real (Real'Machine_Radix) ** (Real'Mantissa / 2 + 4); - W, X, Y, Z : Real; - CX : Complex; - Actual, Expected : Complex; - begin - Accuracy_Error_Reported := False; -- reset - for II in 1..Max_Samples loop - X := (RB - RA) * Real (II) / Real (Max_Samples) + RA; - for J in 1..Max_Samples loop - Y := (IB - IA) * Real (J) / Real (Max_Samples) + IA; - - -- purify the arguments to minimize roundoff error. - -- We construct the values so that the products X*X, - -- Y*Y, and X*Y are all exact machine numbers. - -- See Cody page 7 and CELEFUNT code. - Z := X * Scale; - W := Z + X; - X := W - Z; - Z := Y * Scale; - W := Z + Y; - Y := W - Z; - -- G.1.2(21);6.0 - real part of result is non-negative - Expected := Compose_From_Cartesian( abs X,Y); - Z := X*X - Y*Y; - W := X*Y; - CX := Compose_From_Cartesian(Z,W+W); - - -- The arguments are now ready so on with the - -- identity computation. - Actual := Sqrt(CX); - - Check (Actual, Expected, - "Identity_1_Test " & Integer'Image (II) & - Integer'Image (J) & ": Sqrt((" & - Real'Image (CX.Re) & ", " & - Real'Image (CX.Im) & ")) ", - 8.5); -- 6.0 from sqrt, 2.5 from argument. - -- See Cody pg 7-8 for analysis of additional error amount. - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - return; - end if; - end loop; - end loop; - - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Identity_Test" & - " for X=(" & Real'Image (X) & - ", " & Real'Image (X) & ")"); - when others => - Report.Failed ("exception in Identity_Test" & - " for X=(" & Real'Image (X) & - ", " & Real'Image (X) & ")"); - end Identity_Test; - - - procedure Do_Test is - begin - Special_Value_Test; - Exact_Result_Test; - -- ranges where the sign is the same and where it - -- differs. - Identity_Test ( 0.0, 10.0, 0.0, 10.0); - Identity_Test ( 0.0, 100.0, -100.0, 0.0); - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2020", - "Check the accuracy of the complex SQRT function"); - - 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 CXG2020; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a deleted file mode 100644 index db49fc845f2..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a +++ /dev/null @@ -1,386 +0,0 @@ --- CXG2021.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 complex SIN and COS functions return --- a result that is within the error bound allowed. --- --- TEST DESCRIPTION: --- This test consists of a generic package that is --- instantiated to check complex numbers based upon --- both Float and a long float type. --- The test for each floating point type is divided into --- several parts: --- Special value checks where the result is a known constant. --- Checks that use an identity for determining the result. --- --- 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: --- 27 Mar 96 SAIC Initial release for 2.1 --- 22 Aug 96 SAIC No longer skips test for systems with --- more than 20 digits of precision. --- ---! - --- --- References: --- --- W. J. Cody --- CELEFUNT: A Portable Test Package for Complex Elementary Functions --- Algorithm 714, Collected Algorithms from ACM. --- Published in Transactions On Mathematical Software, --- Vol. 19, No. 1, March, 1993, pp. 1-21. --- --- CRC Standard Mathematical Tables --- 23rd Edition --- - -with System; -with Report; -with Ada.Numerics.Generic_Complex_Types; -with Ada.Numerics.Generic_Complex_Elementary_Functions; -procedure CXG2021 is - Verbose : constant Boolean := False; - -- Note that Max_Samples is the number of samples taken in - -- both the real and imaginary directions. Thus, for Max_Samples - -- of 100 the number of values checked is 10000. - Max_Samples : constant := 100; - - E : constant := Ada.Numerics.E; - Pi : constant := Ada.Numerics.Pi; - - generic - type Real is digits <>; - package Generic_Check is - procedure Do_Test; - end Generic_Check; - - package body Generic_Check is - package Complex_Type is new - Ada.Numerics.Generic_Complex_Types (Real); - use Complex_Type; - - package CEF is new - Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type); - - function Sin (X : Complex) return Complex renames CEF.Sin; - function Cos (X : Complex) return Complex renames CEF.Cos; - - -- flag used to terminate some tests early - Accuracy_Error_Reported : Boolean := False; - - -- The following value is a lower bound on the accuracy - -- required. It is normally 0.0 so that the lower bound - -- is computed from Model_Epsilon. However, for tests - -- where the expected result is only known to a certain - -- amount of precision this bound takes on a non-zero - -- value to account for that level of precision. - Error_Low_Bound : Real := 0.0; - - -- the E_Factor is an additional amount added to the Expected - -- value prior to computing the maximum relative error. - -- This is needed because the error analysis (Cody pg 17-20) - -- requires this additional allowance. - procedure Check (Actual, Expected : Real; - Test_Name : String; - MRE : Real; - E_Factor : Real := 0.0) is - Max_Error : Real; - Rel_Error : Real; - Abs_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 * Real'Model_Epsilon * (abs Expected + E_Factor); - Abs_Error := MRE * Real'Model_Epsilon; - if Rel_Error > Abs_Error then - Max_Error := Rel_Error; - else - Max_Error := Abs_Error; - end if; - - -- take into account the low bound on the error - if Max_Error < Error_Low_Bound then - Max_Error := Error_Low_Bound; - end if; - - if abs (Actual - Expected) > Max_Error then - Accuracy_Error_Reported := True; - Report.Failed (Test_Name & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) & - " efactor:" & Real'Image (E_Factor) ); - elsif Verbose then - if Actual = Expected then - Report.Comment (Test_Name & " exact result"); - else - Report.Comment (Test_Name & " passed" & - " actual: " & Real'Image (Actual) & - " expected: " & Real'Image (Expected) & - " difference: " & Real'Image (Actual - Expected) & - " max err:" & Real'Image (Max_Error) & - " efactor:" & Real'Image (E_Factor) ); - end if; - end if; - end Check; - - - procedure Check (Actual, Expected : Complex; - Test_Name : String; - MRE : Real; - R_Factor, I_Factor : Real := 0.0) is - begin - Check (Actual.Re, Expected.Re, Test_Name & " real part", - MRE, R_Factor); - Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", - MRE, I_Factor); - end Check; - - - procedure Special_Value_Test is - -- In the following tests the expected result is accurate - -- to the machine precision so the minimum guaranteed error - -- bound can be used if the argument is exact. - -- Since the argument involves Pi, we must allow for this - -- inexact argument. - Minimum_Error : constant := 11.0; - begin - Check (Sin (Pi/2.0 + 0.0*i), - 1.0 + 0.0*i, - "sin(pi/2+0i)", - Minimum_Error + 1.0); - Check (Cos (Pi/2.0 + 0.0*i), - 0.0 + 0.0*i, - "cos(pi/2+0i)", - Minimum_Error + 1.0); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in special value test"); - when others => - Report.Failed ("exception in special value test"); - end Special_Value_Test; - - - - procedure Exact_Result_Test is - No_Error : constant := 0.0; - begin - -- G.1.2(36);6.0 - Check (Sin(0.0 + 0.0*i), 0.0 + 0.0 * i, "sin(0+0i)", No_Error); - Check (Cos(0.0 + 0.0*i), 1.0 + 0.0 * i, "cos(0+0i)", No_Error); - exception - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Exact_Result Test"); - when others => - Report.Failed ("exception in Exact_Result Test"); - end Exact_Result_Test; - - - procedure Identity_Test (RA, RB, IA, IB : Real) is - -- Tests an identity over a range of values specified - -- by the 4 parameters. RA and RB denote the range for the - -- real part while IA and IB denote the range for the - -- imaginary part. - -- - -- For this test we use the identity - -- Sin(Z) = Sin(Z-W) * Cos(W) + Cos(Z-W) * Sin(W) - -- and - -- Cos(Z) = Cos(Z-W) * Cos(W) - Sin(Z-W) * Sin(W) - -- - - X, Y : Real; - Z : Complex; - W : constant Complex := Compose_From_Cartesian(0.0625, 0.0625); - ZmW : Complex; -- Z - W - Sin_ZmW, - Cos_ZmW : Complex; - Actual1, Actual2 : Complex; - R_Factor : Real; -- additional real error factor - I_Factor : Real; -- additional imaginary error factor - Sin_W : constant Complex := (6.2581348413276935585E-2, - 6.2418588008436587236E-2); - -- numeric stability is enhanced by using Cos(W) - 1.0 instead of - -- Cos(W) in the computation. - Cos_W_m_1 : constant Complex := (-2.5431314180235545803E-6, - -3.9062493377261771826E-3); - - - begin - if Real'Digits > 20 then - -- constants used here accurate to 20 digits. Allow 1 - -- additional digit of error for computation. - Error_Low_Bound := 0.00000_00000_00000_0001; - Report.Comment ("accuracy checked to 19 digits"); - end if; - - Accuracy_Error_Reported := False; -- reset - for II in 0..Max_Samples loop - X := (RB - RA) * Real (II) / Real (Max_Samples) + RA; - for J in 0..Max_Samples loop - Y := (IB - IA) * Real (J) / Real (Max_Samples) + IA; - - Z := Compose_From_Cartesian(X,Y); - ZmW := Z - W; - Sin_ZmW := Sin (ZmW); - Cos_ZmW := Cos (ZmW); - - -- now for the first identity - -- Sin(Z) = Sin(Z-W) * Cos(W) + Cos(Z-W) * Sin(W) - -- = Sin(Z-W) * (1+(Cos(W)-1)) + Cos(Z-W) * Sin(W) - -- = Sin(Z-W) + Sin(Z-W)*(Cos(W)-1) + Cos(Z-W)*Sin(W) - - - Actual1 := Sin (Z); - Actual2 := Sin_ZmW + (Sin_ZmW * Cos_W_m_1 + Cos_ZmW * Sin_W); - - -- The computation of the additional error factors are taken - -- from Cody pages 17-20. - - R_Factor := abs (Re (Sin_ZmW) * Re (1.0 - Cos_W_m_1)) + - abs (Im (Sin_ZmW) * Im (1.0 - Cos_W_m_1)) + - abs (Re (Cos_ZmW) * Re (Sin_W)) + - abs (Re (Cos_ZmW) * Re (1.0 - Cos_W_m_1)); - - I_Factor := abs (Re (Sin_ZmW) * Im (1.0 - Cos_W_m_1)) + - abs (Im (Sin_ZmW) * Re (1.0 - Cos_W_m_1)) + - abs (Re (Cos_ZmW) * Im (Sin_W)) + - abs (Im (Cos_ZmW) * Re (1.0 - Cos_W_m_1)); - - Check (Actual1, Actual2, - "Identity_1_Test " & Integer'Image (II) & - Integer'Image (J) & ": Sin((" & - Real'Image (Z.Re) & ", " & - Real'Image (Z.Im) & ")) ", - 11.0, R_Factor, I_Factor); - - -- now for the second identity - -- Cos(Z) = Cos(Z-W) * Cos(W) - Sin(Z-W) * Sin(W) - -- = Cos(Z-W) * (1+(Cos(W)-1) - Sin(Z-W) * Sin(W) - Actual1 := Cos (Z); - Actual2 := Cos_ZmW + (Cos_ZmW * Cos_W_m_1 - Sin_ZmW * Sin_W); - - -- The computation of the additional error factors are taken - -- from Cody pages 17-20. - - R_Factor := abs (Re (Sin_ZmW) * Re (Sin_W)) + - abs (Im (Sin_ZmW) * Im (Sin_W)) + - abs (Re (Cos_ZmW) * Re (1.0 - Cos_W_m_1)) + - abs (Im (Cos_ZmW) * Im (1.0 - Cos_W_m_1)); - - I_Factor := abs (Re (Sin_ZmW) * Im (Sin_W)) + - abs (Im (Sin_ZmW) * Re (Sin_W)) + - abs (Re (Cos_ZmW) * Im (1.0 - Cos_W_m_1)) + - abs (Im (Cos_ZmW) * Re (1.0 - Cos_W_m_1)); - - Check (Actual1, Actual2, - "Identity_2_Test " & Integer'Image (II) & - Integer'Image (J) & ": Cos((" & - Real'Image (Z.Re) & ", " & - Real'Image (Z.Im) & ")) ", - 11.0, R_Factor, I_Factor); - - if Accuracy_Error_Reported then - -- only report the first error in this test in order to keep - -- lots of failures from producing a huge error log - Error_Low_Bound := 0.0; -- reset - return; - end if; - end loop; - end loop; - - Error_Low_Bound := 0.0; -- reset - exception - when Constraint_Error => - Report.Failed - ("Constraint_Error raised in Identity_Test" & - " for Z=(" & Real'Image (X) & - ", " & Real'Image (Y) & ")"); - when others => - Report.Failed ("exception in Identity_Test" & - " for Z=(" & Real'Image (X) & - ", " & Real'Image (Y) & ")"); - end Identity_Test; - - - procedure Do_Test is - begin - Special_Value_Test; - Exact_Result_Test; - -- test regions where sin and cos have the same sign and - -- about the same magnitude. This will minimize subtraction - -- errors in the identities. - -- See Cody page 17. - Identity_Test (0.0625, 10.0, 0.0625, 10.0); - Identity_Test ( 16.0, 17.0, 16.0, 17.0); - end Do_Test; - end Generic_Check; - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - package Float_Check is new Generic_Check (Float); - - -- check the floating point type with the most digits - type A_Long_Float is digits System.Max_Digits; - package A_Long_Float_Check is new Generic_Check (A_Long_Float); - - ----------------------------------------------------------------------- - ----------------------------------------------------------------------- - - -begin - Report.Test ("CXG2021", - "Check the accuracy of the complex SIN and COS 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 CXG2021; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a deleted file mode 100644 index f9e4d1cae33..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a +++ /dev/null @@ -1,309 +0,0 @@ --- CXG2022.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 multiplication and division of binary fixed point --- numbers with compatible 'small values produce exact results. --- --- TEST DESCRIPTION: --- Signed, unsigned, and a mixture of signed and unsigned --- binary fixed point values are multiplied and divided. --- The result is checked against the expected "perfect result set" --- --- 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: --- 1 Apr 96 SAIC Initial release for 2.1 --- 29 Jan 1998 EDS Repaired fixed point errors ("**" and --- assumptions about 'Small) ---! - -with System; -with Report; -procedure CXG2022 is - Verbose : constant Boolean := False; - -procedure Check_Signed is - type Pairs is delta 2.0 range -2.0 ** (System.Max_Mantissa) .. - 2.0 ** (System.Max_Mantissa) - 1.0; - type Halves is delta 0.5 range -2.0 ** (System.Max_Mantissa-2) .. - 2.0 ** (System.Max_Mantissa-2) - 1.0; - P1, P2, P3, P4 : Pairs; - H1, H2, H3, H4 : Halves; - - procedure Dont_Opt is - -- keep optimizer from knowing the constant value of expressions - begin - if Report.Ident_Bool (False) then - P1 := 2.0; P2 := 4.0; P3 := 6.0; - H1 := -2.0; H2 := 9.0; H3 := 3.0; - end if; - end Dont_Opt; - -begin - H1 := -0.5; - H2 := Halves'First; - H3 := 1.0; - P1 := 12.0; - P2 := Pairs'First; - P3 := Pairs'Last; - Dont_Opt; - - P4 := Pairs (P1 * H1); -- 12.0 * -0.5 - if P4 /= -6.0 then - Report.Failed ("12.0 * -0.5 = " & Pairs'Image (P4)); - end if; - - H4 := Halves (P1 / H1); -- 12.0 / -0.5 - if H4 /= -24.0 then - Report.Failed ("12.0 / -0.5 = " & Halves'Image (H4)); - end if; - - P4 := P3 * H3; -- Pairs'Last * 1.0 - if P4 /= Pairs'Last then - Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4)); - end if; - - P4 := P3 / H3; -- Pairs'Last / 1.0 - if P4 /= Pairs'Last then - Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4)); - end if; - - P4 := P2 * 0.25; -- Pairs'First * 0.25 - if P4 /= Pairs (-2.0 ** (System.Max_Mantissa - 2)) then - Report.Failed ("Pairs'First * 0.25 = " & Pairs'Image (P4)); - end if; - - P4 := 100.5 / H1; -- 100.5 / -0.5 - if P4 = -201.0 then - null; -- Perfect result - elsif Pairs'Small = 2.0 and ( P4 = -200.0 or P4 = -202.0 ) then - null; -- Allowed variation - else - Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) & - " and 100.5/-0.5 = " & Pairs'Image (P4) ); - end if; - - H4 := H1 * H2; -- -0.5 * Halves'First - if H4 /= Halves (2.0 ** (System.Max_Mantissa-3)) then - Report.Failed ("-0.5 * Halves'First =" & Halves'Image (H4) & - " instead of " & - Halves'Image( Halves(2.0 ** (System.Max_Mantissa-3)))); - end if; - -exception - when others => - Report.Failed ("unexpected exception in Check_Signed"); -end Check_Signed; - - - -procedure Check_Unsigned is - type Pairs is delta 2.0 range 0.0 .. 2.0 ** (System.Max_Mantissa+1) - 1.0; - type Halves is delta 0.5 range 0.0 .. 2.0 ** (System.Max_Mantissa-1) - 1.0; - P1, P2, P3, P4 : Pairs; - H1, H2, H3, H4 : Halves; - - procedure Dont_Opt is - -- keep optimizer from knowing the constant value of expressions - begin - if Report.Ident_Bool (False) then - P1 := 2.0; P2 := 4.0; P3 := 6.0; - H1 := 2.0; H2 := 9.0; H3 := 3.0; - end if; - end Dont_Opt; - -begin - H1 := 10.5; - H2 := Halves(2.0 ** (System.Max_Mantissa - 6)); - H3 := 1.0; - P1 := 12.0; - P2 := Pairs'Last / 2; - P3 := Pairs'Last; - Dont_Opt; - - P4 := Pairs (P1 * H1); -- 12.0 * 10.5 - if P4 /= 126.0 then - Report.Failed ("12.0 * 10.5 = " & Pairs'Image (P4)); - end if; - - H4 := Halves (P1 / H1); -- 12.0 / 10.5 - if H4 /= 1.0 and H4 /= 1.5 then - Report.Failed ("12.0 / 10.5 = " & Halves'Image (H4)); - end if; - - P4 := P3 * H3; -- Pairs'Last * 1.0 - if P4 /= Pairs'Last then - Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4)); - end if; - - P4 := P3 / H3; -- Pairs'Last / 1.0 - if P4 /= Pairs'Last then - Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4)); - end if; - - P4 := P1 * 0.25; -- 12.0 * 0.25 - if P4 /= 2.0 and P4 /= 4.0 then - Report.Failed ("12.0 * 0.25 = " & Pairs'Image (P4)); - end if; - - P4 := 100.5 / H1; -- 100.5 / 10.5 = 9.571... - if P4 /= 8.0 and P4 /= 10.0 then - Report.Failed ("100.5/10.5 = " & Pairs'Image (P4)); - end if; - - H4 := H2 * 2; -- 2**(max_mantissa-6) * 2 - if H4 /= Halves(2.0 ** (System.Max_Mantissa-5)) then - Report.Failed ("2**(System.Max_Mantissa-6) * 2=" & Halves'Image (H4) & - " instead of " & - Halves'Image( Halves(2.0 ** (System.Max_Mantissa-5)))); - end if; - -exception - when others => - Report.Failed ("unexpected exception in Check_Unsigned"); -end Check_Unsigned; - - - -procedure Check_Mixed is - type Pairs is delta 2.0 range -2.0 ** (System.Max_Mantissa) .. - 2.0 ** (System.Max_Mantissa) - 1.0; - type Halves is delta 0.5 range 0.0 .. 2.0 ** (System.Max_Mantissa-1) - 1.0; - P1, P2, P3, P4 : Pairs; - H1, H2, H3, H4 : Halves; - - procedure Dont_Opt is - -- keep optimizer from knowing the constant value of expressions - begin - if Report.Ident_Bool (False) then - P1 := 2.0; P2 := 4.0; P3 := 6.0; - H1 := 2.0; H2 := 9.0; H3 := 3.0; - end if; - end Dont_Opt; - -begin - H1 := 10.5; - H2 := Halves(2.0 ** (System.Max_Mantissa - 6)); - H3 := 1.0; - P1 := 12.0; - P2 := -4.0; - P3 := Pairs'Last; - Dont_Opt; - - P4 := Pairs (P1 * H1); -- 12.0 * 10.5 - if P4 /= 126.0 then - Report.Failed ("12.0 * 10.5 = " & Pairs'Image (P4)); - end if; - - H4 := Halves (P1 / H1); -- 12.0 / 10.5 - if H4 /= 1.0 and H4 /= 1.5 then - Report.Failed ("12.0 / 10.5 = " & Halves'Image (H4)); - end if; - - P4 := P3 * H3; -- Pairs'Last * 1.0 - if P4 /= Pairs'Last then - Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4)); - end if; - - P4 := P3 / H3; -- Pairs'Last / 1.0 - if P4 /= Pairs'Last then - Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4)); - end if; - - P4 := P1 * 0.25; -- 12.0 * 0.25 - if P4 = 3.0 then - null; -- Perfect result - elsif Pairs'Small = 2.0 and then ( P4 = 2.0 or P4 = 4.0 ) then - null; -- Allowed deviation - else - Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) & - "and 12.0 * 0.25 = " & Pairs'Image (P4) ); - end if; - - P4 := 100.5 / H1; -- 100.5 / 10.5 = 9.571... - if P4 = 9.0 then - null; -- Perfect result - elsif Pairs'Small = 2.0 and then ( P4 = 8.0 or P4 = 10.0 ) then - null; -- Allowed values - else - Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) & - "and 100.5/10.5 = " & Pairs'Image (P4) ); - end if; - - H4 := H2 * 2; -- 2**(max_mantissa-6) * 2 - if H4 /= Halves(2.0 ** (System.Max_Mantissa-5)) then - Report.Failed ("2**(System.Max_Mantissa-6) * 2=" & Halves'Image (H4) & - " instead of " & - Halves'Image( Halves(2.0 ** (System.Max_Mantissa-5)))); - end if; - - P4 := Pairs(P1 * 6) / P2; -- 12 * 6 / -4 - if (P4 /= -18.0) then - Report.Failed ("12*6/-4 = " & Pairs'Image(P4)); - end if; - - P4 := Halves(P1 * 6.0) / P2; -- 12 * 6 / -4 - if (P4 /= -18.0) then - Report.Failed ("Halves(12*6)/-4 = " & Pairs'Image(P4)); - end if; - -exception - when others => - Report.Failed ("unexpected exception in Check_Mixed"); -end Check_Mixed; - - -begin -- main - Report.Test ("CXG2022", - "Check the accuracy of multiplication and division" & - " of binary fixed point numbers"); - if Verbose then - Report.Comment ("starting signed test"); - end if; - Check_Signed; - - if Verbose then - Report.Comment ("starting unsigned test"); - end if; - Check_Unsigned; - - if Verbose then - Report.Comment ("starting mixed sign test"); - end if; - Check_Mixed; - - Report.Result; -end CXG2022; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a deleted file mode 100644 index 0cdd5574e09..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a +++ /dev/null @@ -1,351 +0,0 @@ --- CXG2023.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 multiplication and division of decimal fixed point --- numbers produce exact results. --- --- TEST DESCRIPTION: --- Check that multiplication and division of decimal fixed point --- numbers produce exact results. --- --- 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. --- This test applies only to implementations supporting --- decimal fixed point types of at least 9 digits. --- --- --- CHANGE HISTORY: --- 3 Apr 96 SAIC Initial release for 2.1 --- ---! - -with System; -with Report; -procedure CXG2023 is - Verbose : constant Boolean := False; - -procedure Check_1 is - Num_Digits : constant := 6; - type Pennies is delta 0.01 digits Num_Digits; - type Franklins is delta 100.0 digits Num_Digits; - type Dollars is delta 1.0 digits Num_Digits; - - P1 : Pennies; - F1 : Franklins; - D1 : Dollars; - - -- optimization thwarting functions - - function P (X : Pennies) return Pennies is - begin - if Report.Ident_Bool (True) then - return X; - else - return 3.21; -- never executed - end if; - end P; - - - function F (X : Franklins) return Franklins is - begin - if Report.Ident_Bool (True) then - return X; - else - return 32100.0; -- never executed - end if; - end F; - - - function D (X : Dollars) return Dollars is - begin - if Report.Ident_Bool (True) then - return X; - else - return 321.0; -- never executed - end if; - end D; - - -begin - -- multiplication where one operand is universal real - - P1 := P(0.05) * 200.0; - if P1 /= 10.00 then - Report.Failed ("1 - expected 10.00 got " & Pennies'Image (P1)); - end if; - - D1 := P(0.05) * 100.0; - if D1 /= 5.00 then - Report.Failed ("2 - expected 5.00 got " & Dollars'Image (D1)); - end if; - - F1 := P(0.05) * 50_000.0; - if F1 /= 2500.00 then - Report.Failed ("3 - expected 2500.0 got " & Franklins'Image (F1)); - end if; - - -- multiplication where both operands are decimal fixed - - P1 := P(0.05) * D(-200.0); - if P1 /= -10.00 then - Report.Failed ("4 - expected -10.00 got " & Pennies'Image (P1)); - end if; - - D1 := P(0.05) * P(-100.0); - if D1 /= -5.00 then - Report.Failed ("5 - expected -5.00 got " & Dollars'Image (D1)); - end if; - - F1 := P(-0.05) * F(50_000.0); - if F1 /= -2500.00 then - Report.Failed ("6 - expected -2500.0 got " & Franklins'Image (F1)); - end if; - - -- division where one operand is universal real - - P1 := P(0.05) / 0.001; - if P1 /= 50.00 then - Report.Failed ("7 - expected 50.00 got " & Pennies'Image (P1)); - end if; - - D1 := D(1000.0) / 3.0; - if D1 /= 333.00 then - Report.Failed ("8 - expected 333.00 got " & Dollars'Image (D1)); - end if; - - F1 := P(1234.56) / 0.0001; - if F1 /= 12345600.00 then - Report.Failed ("9 - expected 12345600.0 got " & Franklins'Image (F1)); - end if; - - - -- division where both operands are decimal fixed - - P1 := P(0.05) / D(1.0); - if P1 /= 0.05 then - Report.Failed ("10 - expected 0.05 got " & Pennies'Image (P1)); - end if; - - -- check for truncation toward 0 - D1 := P(-101.00) / P(2.0); - if D1 /= -50.00 then - Report.Failed ("11 - expected -50.00 got " & Dollars'Image (D1)); - end if; - - P1 := P(-102.03) / P(-0.5); - if P1 /= 204.06 then - Report.Failed ("12 - expected 204.06 got " & Pennies'Image (P1)); - end if; - - F1 := P(876.54) / P(0.03); - if F1 /= 29200.00 then - Report.Failed ("13 - expected 29200.0 got " & Franklins'Image (F1)); - end if; - -exception - when others => - Report.Failed ("unexpected exception in Check_1"); -end Check_1; - -generic - type Pennies is delta<> digits<>; - type Dollars is delta<> digits<>; - type Franklins is delta<> digits<>; -procedure Generic_Check; -procedure Generic_Check is - - -- the following code is copied directly from the - -- above procedure Check_1 - - P1 : Pennies; - F1 : Franklins; - D1 : Dollars; - - -- optimization thwarting functions - - function P (X : Pennies) return Pennies is - begin - if Report.Ident_Bool (True) then - return X; - else - return 3.21; -- never executed - end if; - end P; - - - function F (X : Franklins) return Franklins is - begin - if Report.Ident_Bool (True) then - return X; - else - return 32100.0; -- never executed - end if; - end F; - - - function D (X : Dollars) return Dollars is - begin - if Report.Ident_Bool (True) then - return X; - else - return 321.0; -- never executed - end if; - end D; - - -begin - -- multiplication where one operand is universal real - - P1 := P(0.05) * 200.0; - if P1 /= 10.00 then - Report.Failed ("1 - expected 10.00 got " & Pennies'Image (P1)); - end if; - - D1 := P(0.05) * 100.0; - if D1 /= 5.00 then - Report.Failed ("2 - expected 5.00 got " & Dollars'Image (D1)); - end if; - - F1 := P(0.05) * 50_000.0; - if F1 /= 2500.00 then - Report.Failed ("3 - expected 2500.0 got " & Franklins'Image (F1)); - end if; - - -- multiplication where both operands are decimal fixed - - P1 := P(0.05) * D(-200.0); - if P1 /= -10.00 then - Report.Failed ("4 - expected -10.00 got " & Pennies'Image (P1)); - end if; - - D1 := P(0.05) * P(-100.0); - if D1 /= -5.00 then - Report.Failed ("5 - expected -5.00 got " & Dollars'Image (D1)); - end if; - - F1 := P(-0.05) * F(50_000.0); - if F1 /= -2500.00 then - Report.Failed ("6 - expected -2500.0 got " & Franklins'Image (F1)); - end if; - - -- division where one operand is universal real - - P1 := P(0.05) / 0.001; - if P1 /= 50.00 then - Report.Failed ("7 - expected 50.00 got " & Pennies'Image (P1)); - end if; - - D1 := D(1000.0) / 3.0; - if D1 /= 333.00 then - Report.Failed ("8 - expected 333.00 got " & Dollars'Image (D1)); - end if; - - F1 := P(1234.56) / 0.0001; - if F1 /= 12345600.00 then - Report.Failed ("9 - expected 12345600.0 got " & Franklins'Image (F1)); - end if; - - - -- division where both operands are decimal fixed - - P1 := P(0.05) / D(1.0); - if P1 /= 0.05 then - Report.Failed ("10 - expected 0.05 got " & Pennies'Image (P1)); - end if; - - -- check for truncation toward 0 - D1 := P(-101.00) / P(2.0); - if D1 /= -50.00 then - Report.Failed ("11 - expected -50.00 got " & Dollars'Image (D1)); - end if; - - P1 := P(-102.03) / P(-0.5); - if P1 /= 204.06 then - Report.Failed ("12 - expected 204.06 got " & Pennies'Image (P1)); - end if; - - F1 := P(876.54) / P(0.03); - if F1 /= 29200.00 then - Report.Failed ("13 - expected 29200.0 got " & Franklins'Image (F1)); - end if; - -end Generic_Check; - - -procedure Check_G6 is - Num_Digits : constant := 6; - type Pennies is delta 0.01 digits Num_Digits; - type Franklins is delta 100.0 digits Num_Digits; - type Dollars is delta 1.0 digits Num_Digits; - - procedure G is new Generic_Check (Pennies, Dollars, Franklins); -begin - G; -end Check_G6; - - -procedure Check_G9 is - Num_Digits : constant := 9; - type Pennies is delta 0.01 digits Num_Digits; - type Franklins is delta 100.0 digits Num_Digits; - type Dollars is delta 1.0 digits Num_Digits; - - procedure G is new Generic_Check (Pennies, Dollars, Franklins); -begin - G; -end Check_G9; - - -begin -- main - Report.Test ("CXG2023", - "Check the accuracy of multiplication and division" & - " of decimal fixed point numbers"); - - if Verbose then - Report.Comment ("starting Check_1"); - end if; - Check_1; - - if Verbose then - Report.Comment ("starting Check_G6"); - end if; - Check_G6; - - if Verbose then - Report.Comment ("starting Check_G9"); - end if; - Check_G9; - - Report.Result; -end CXG2023; diff --git a/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a b/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a deleted file mode 100644 index 55648283eba..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a +++ /dev/null @@ -1,191 +0,0 @@ --- CXG2024.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 multiplication and division of decimal --- and binary fixed point numbers that result in a --- decimal fixed point type produce acceptable results. --- --- TEST DESCRIPTION: --- Multiplication and division of mixed binary and decimal --- values are performed. Identity functions are used so --- that the operands of the expressions will not be seen --- as static by the compiler. --- --- 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. --- This test applies only to implementations supporting --- decimal fixed point types of at least 9 digits. --- --- --- CHANGE HISTORY: --- 4 Apr 96 SAIC Initial release for 2.1 --- 17 Aug 96 SAIC Removed checks for close results --- ---! - -with System; -with Report; -procedure CXG2024 is - -procedure Do_Check is - Num_Digits : constant := 9; - type Pennies is delta 0.01 digits Num_Digits; - type Dollars is delta 1.0 digits Num_Digits; - - type Signed_Sixteenths is delta 0.0625 - range -2.0 ** (System.Max_Mantissa-5) .. - 2.0 ** (System.Max_Mantissa-5) - 1.0; - type Unsigned_Sixteenths is delta 0.0625 - range 0.0 .. 2.0 ** (System.Max_Mantissa-4) - 1.0; - - P1 : Pennies; - D1 : Dollars; - - -- optimization thwarting functions - - function P (X : Pennies) return Pennies is - begin - if Report.Ident_Bool (True) then - return X; - else - return 3.21; -- never executed - end if; - end P; - - - function D (X : Dollars) return Dollars is - begin - if Report.Ident_Bool (True) then - return X; - else - return 321.0; -- never executed - end if; - end D; - - - function US (X : Unsigned_Sixteenths) return Unsigned_Sixteenths is - begin - if Report.Ident_Bool (True) then - return X; - else - return 321.0; -- never executed - end if; - end US; - - - function SS (X : Signed_Sixteenths) return Signed_Sixteenths is - begin - if Report.Ident_Bool (True) then - return X; - else - return 321.0; -- never executed - end if; - end SS; - - -begin - - P1 := P(0.05) * SS(-200.0); - if P1 /= -10.00 then - Report.Failed ("1 - expected -10.00 got " & Pennies'Image (P1)); - end if; - - D1 := P(0.05) * SS(-100.0); - if D1 /= -5.00 then - Report.Failed ("2 - expected -5.00 got " & Dollars'Image (D1)); - end if; - - P1 := P(0.05) * US(200.0); - if P1 /= 10.00 then - Report.Failed ("3 - expected 10.00 got " & Pennies'Image (P1)); - end if; - - D1 := P(-0.05) * US(100.0); - if D1 /= -5.00 then - Report.Failed ("4 - expected -5.00 got " & Dollars'Image (D1)); - end if; - - - - P1 := P(0.05) / US(1.0); - if P1 /= 0.05 then - Report.Failed ("6 - expected 0.05 got " & Pennies'Image (P1)); - end if; - - - -- check rounding - - D1 := Dollars'Round (Pennies (P(-101.00) / US(2.0))); - if D1 /= -51.00 then - Report.Failed ("11 - expected -51.00 got " & Dollars'Image (D1)); - end if; - - D1 := Dollars'Round (Pennies (P(101.00) / US(2.0))); - if D1 /= 51.00 then - Report.Failed ("12 - expected 51.00 got " & Dollars'Image (D1)); - end if; - - D1 := Dollars'Round (Pennies (SS(-101.00) / P(2.0))); - if D1 /= -51.00 then - Report.Failed ("13 - expected -51.00 got " & Dollars'Image (D1)); - end if; - - D1 := Dollars'Round (Pennies (US(101.00) / P(2.0))); - if D1 /= 51.00 then - Report.Failed ("14 - expected 51.00 got " & Dollars'Image (D1)); - end if; - - - - P1 := P(-102.03) / SS(-0.5); - if P1 /= 204.06 then - Report.Failed ("15 - expected 204.06 got " & Pennies'Image (P1)); - end if; - - -exception - when others => - Report.Failed ("unexpected exception in Do_Check"); -end Do_Check; - - -begin -- main - Report.Test ("CXG2024", - "Check the accuracy of multiplication and division" & - " of mixed decimal and binary fixed point numbers"); - - Do_Check; - - Report.Result; -end CXG2024; |