gomp-20050608-branch/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a

   1 -- CXG2016.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that the ARCTAN function returns a
  28 --      result that is within the error bound allowed.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      This test consists of a generic package that is
  32 --      instantiated to check both Float and a long float type.
  33 --      The test for each floating point type is divided into
  34 --      several parts:
  35 --         Special value checks where the result is a known constant.
  36 --         Exception checks.
  37 --
  38 -- SPECIAL REQUIREMENTS
  39 --      The Strict Mode for the numerical accuracy must be
  40 --      selected.  The method by which this mode is selected
  41 --      is implementation dependent.
  42 --
  43 -- APPLICABILITY CRITERIA:
  44 --      This test applies only to implementations supporting the
  45 --      Numerics Annex.
  46 --      This test only applies to the Strict Mode for numerical
  47 --      accuracy.
  48 --
  49 --
  50 -- CHANGE HISTORY:
  51 --      19 Mar 96   SAIC    Initial release for 2.1
  52 --      30 APR 96   SAIC    Fixed optimization issue
  53 --      17 AUG 96   SAIC    Incorporated Reviewer's suggestions.
  54 --      12 OCT 96   SAIC    Incorporated Reviewer's suggestions.
  55 --      02 DEC 97   EDS     Remove procedure Identity_1_Test and calls to
  56 --                          procedure.
  57 --      29 JUN 98   EDS     Replace -0.0 with call to ImpDef.Annex_G.Negative_Zero
  58 --      28 APR 99   RLB     Replaced comma accidentally deleted in above change.
  59 --      15 DEC 99   RLB     Added model range checking to "exact" results,
  60 --                          in order to avoid too strictly requiring a specific
  61 --                          result.
  62 --!
  63
  64 --
  65 -- References:
  66 --
  67 -- Software Manual for the Elementary Functions
  68 -- William J. Cody, Jr. and William Waite
  69 -- Prentice-Hall, 1980
  70 --
  71 -- CRC Standard Mathematical Tables
  72 -- 23rd Edition
  73 --
  74 -- Implementation and Testing of Function Software
  75 -- W. J. Cody
  76 -- Problems and Methodologies in Mathematical Software Production
  77 -- editors P. C. Messina and A. Murli
  78 -- Lecture Notes in Computer Science   Volume 142
  79 -- Springer Verlag, 1982
  80 --
  81
  82 with System;
  83 with Report;
  84 with Ada.Numerics.Generic_Elementary_Functions;
  85 with Impdef.Annex_G;
  86 procedure CXG2016 is
  87    Verbose : constant Boolean := False;
  88    Max_Samples : constant := 1000;
  89
  90    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
  91    Sqrt2 : constant :=
  92         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
  93    Sqrt3 : constant :=
  94         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
  95
  96    Pi : constant := Ada.Numerics.Pi;
  97
  98    generic
  99       type Real is digits <>;
 100       Half_PI_Low : in Real; -- The machine number closest to, but not greater
 101                              -- than PI/2.0.
 102       Half_PI_High : in Real;-- The machine number closest to, but not less
 103                              -- than PI/2.0.
 104       PI_Low : in Real;      -- The machine number closest to, but not greater
 105                              -- than PI.
 106       PI_High : in Real;     -- The machine number closest to, but not less
 107                              -- than PI.
 108    package Generic_Check is
 109       procedure Do_Test;
 110    end Generic_Check;
 111
 112    package body Generic_Check is
 113       package Elementary_Functions is new
 114            Ada.Numerics.Generic_Elementary_Functions (Real);
 115
 116       function Arctan (Y : Real;
 117                        X : Real := 1.0) return Real renames
 118            Elementary_Functions.Arctan;
 119       function Arctan (Y : Real;
 120                        X : Real := 1.0;
 121                        Cycle : Real) return Real renames
 122            Elementary_Functions.Arctan;
 123
 124       -- flag used to terminate some tests early
 125       Accuracy_Error_Reported : Boolean := False;
 126
 127       -- The following value is a lower bound on the accuracy
 128       -- required.  It is normally 0.0 so that the lower bound
 129       -- is computed from Model_Epsilon.  However, for tests
 130       -- where the expected result is only known to a certain
 131       -- amount of precision this bound takes on a non-zero
 132       -- value to account for that level of precision.
 133       Error_Low_Bound : Real := 0.0;
 134
 135       procedure Check (Actual, Expected : Real;
 136                        Test_Name : String;
 137                        MRE : Real) is
 138          Max_Error : Real;
 139          Rel_Error : Real;
 140          Abs_Error : Real;
 141       begin
 142          -- In the case where the expected result is very small or 0
 143          -- we compute the maximum error as a multiple of Model_Epsilon
 144          -- instead of Model_Epsilon and Expected.
 145          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
 146          Abs_Error := MRE * Real'Model_Epsilon;
 147          if Rel_Error > Abs_Error then
 148             Max_Error := Rel_Error;
 149          else
 150             Max_Error := Abs_Error;
 151          end if;
 152
 153          -- take into account the low bound on the error
 154          if Max_Error < Error_Low_Bound then
 155             Max_Error := Error_Low_Bound;
 156          end if;
 157
 158          if abs (Actual - Expected) > Max_Error then
 159             Accuracy_Error_Reported := True;
 160             Report.Failed (Test_Name &
 161                            " actual: " & Real'Image (Actual) &
 162                            " expected: " & Real'Image (Expected) &
 163                            " difference: " & Real'Image (Actual - Expected) &
 164                            " max err:" & Real'Image (Max_Error) );
 165          elsif Verbose then
 166             if Actual = Expected then
 167                Report.Comment (Test_Name & "  exact result");
 168             else
 169                Report.Comment (Test_Name & "  passed");
 170             end if;
 171          end if;
 172       end Check;
 173
 174
 175       procedure Special_Value_Test is
 176       -- If eta is very small, arctan(x + eta) ~= arctan(x) + eta/(1+x*x).
 177       --
 178       -- For tests 4 and 5, there is an error of 4.0ME for arctan + an
 179       -- additional error of 1.0ME because pi is not exact for a total of 5.0ME.
 180       --
 181       -- In test 3 there is the error for pi plus an additional error
 182       -- of (1.0ME)/4 since sqrt3 is not exact, for a total of 5.25ME.
 183       --
 184       -- In test 2 there is the error for pi plus an additional error
 185       -- of (3/4)(1.0ME) since sqrt3 is not exact, for a total of 5.75ME.
 186
 187
 188          type Data_Point is
 189             record
 190                Degrees,
 191                Radians,
 192                Tangent,
 193                Allowed_Error : Real;
 194             end record;
 195
 196          type Test_Data_Type is array (Positive range <>) of Data_Point;
 197
 198          -- the values in the following table only involve static
 199          -- expressions so no additional loss of precision occurs.
 200          Test_Data : constant Test_Data_Type := (
 201          --  degrees      radians       tangent   error     test #
 202             (  0.0,           0.0,          0.0,   4.0 ),    -- 1
 203             ( 30.0,        Pi/6.0,    Sqrt3/3.0,   5.75),    -- 2
 204             ( 60.0,        Pi/3.0,        Sqrt3,   5.25),    -- 3
 205             ( 45.0,        Pi/4.0,          1.0,   5.0 ),    -- 4
 206             (-45.0,       -Pi/4.0,         -1.0,   5.0 ) );  -- 5
 207
 208       begin
 209          for I in Test_Data'Range loop
 210             Check (Arctan (Test_Data (I).Tangent),
 211                    Test_Data (I).Radians,
 212                    "special value test" & Integer'Image (I) &
 213                       " arctan(" &
 214                       Real'Image (Test_Data (I).Tangent) &
 215                       ")",
 216                    Test_Data (I).Allowed_Error);
 217             Check (Arctan (Test_Data (I).Tangent, Cycle => 360.0),
 218                    Test_Data (I).Degrees,
 219                    "special value test" & Integer'Image (I) &
 220                       " arctan(" &
 221                       Real'Image (Test_Data (I).Tangent) &
 222                       ", cycle=>360)",
 223                    Test_Data (I).Allowed_Error);
 224          end loop;
 225
 226       exception
 227          when Constraint_Error =>
 228             Report.Failed ("Constraint_Error raised in special value test");
 229          when others =>
 230             Report.Failed ("exception in special value test");
 231       end Special_Value_Test;
 232
 233
 234
 235       procedure Check_Exact (Actual, Expected_Low, Expected_High : Real;
 236                              Test_Name : String) is
 237          -- If the expected result is not a model number, then Expected_Low is
 238          -- the first machine number less than the (exact) expected
 239          -- result, and Expected_High is the first machine number greater than
 240          -- the (exact) expected result. If the expected result is a model
 241          -- number, Expected_Low = Expected_High = the result.
 242          Model_Expected_Low  : Real := Expected_Low;
 243          Model_Expected_High : Real := Expected_High;
 244       begin
 245          -- Calculate the first model number nearest to, but below (or equal)
 246          -- to the expected result:
 247          while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop
 248             -- Try the next machine number lower:
 249             Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0);
 250          end loop;
 251          -- Calculate the first model number nearest to, but above (or equal)
 252          -- to the expected result:
 253          while Real'Model (Model_Expected_High) /= Model_Expected_High loop
 254             -- Try the next machine number higher:
 255             Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0);
 256          end loop;
 257
 258          if Actual < Model_Expected_Low or Actual > Model_Expected_High then
 259             Accuracy_Error_Reported := True;
 260             if Actual < Model_Expected_Low then
 261                Report.Failed (Test_Name &
 262                               " actual: " & Real'Image (Actual) &
 263                               " expected low: " & Real'Image (Model_Expected_Low) &
 264                               " expected high: " & Real'Image (Model_Expected_High) &
 265                               " difference: " & Real'Image (Actual - Expected_Low));
 266             else
 267                Report.Failed (Test_Name &
 268                               " actual: " & Real'Image (Actual) &
 269                               " expected low: " & Real'Image (Model_Expected_Low) &
 270                               " expected high: " & Real'Image (Model_Expected_High) &
 271                               " difference: " & Real'Image (Expected_High - Actual));
 272             end if;
 273          elsif Verbose then
 274             Report.Comment (Test_Name & "  passed");
 275          end if;
 276       end Check_Exact;
 277
 278
 279       procedure Exact_Result_Test is
 280       begin
 281          --  A.5.1(40);6.0
 282          Check_Exact (Arctan (0.0, 1.0),       0.0, 0.0, "arctan(0,1)");
 283          Check_Exact (Arctan (0.0, 1.0, 27.0), 0.0, 0.0, "arctan(0,1,27)");
 284
 285          --  G.2.4(11-13);6.0
 286
 287          Check_Exact (Arctan (1.0, 0.0), Half_PI_Low, Half_PI_High,
 288               "arctan(1,0)");
 289          Check_Exact (Arctan (1.0, 0.0, 360.0), 90.0, 90.0, "arctan(1,0,360)");
 290
 291          Check_Exact (Arctan (-1.0, 0.0), -Half_PI_High, -Half_PI_Low,
 292               "arctan(-1,0)");
 293          Check_Exact (Arctan (-1.0, 0.0, 360.0), -90.0, -90.0,
 294               "arctan(-1,0,360)");
 295
 296          if Real'Signed_Zeros then
 297             Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(+0,-1)");
 298             Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
 299                   "arctan(+0,-1,360)");
 300             Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0),
 301                    -PI_High, -PI_Low, "arctan(-0,-1)");
 302             Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0,
 303                    360.0), -180.0, -180.0, "arctan(-0,-1,360)");
 304          else
 305             Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(0,-1)");
 306             Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
 307                    "arctan(0,-1,360)");
 308          end if;
 309       exception
 310          when Constraint_Error =>
 311             Report.Failed ("Constraint_Error raised in Exact_Result Test");
 312          when others =>
 313             Report.Failed ("Exception in Exact_Result Test");
 314       end Exact_Result_Test;
 315
 316
 317       procedure Taylor_Series_Test is
 318       -- This test checks the Arctan by using a taylor series expansion that
 319       -- will produce a result accurate to 19 decimal digits for
 320       -- the range under test.
 321       --
 322       -- The maximum relative error bound for this test is
 323       --  4 for the arctan operation and 2 for the Taylor series
 324       -- for a total of 6 * Model_Epsilon
 325
 326          A : constant := -1.0/16.0;
 327          B : constant :=  1.0/16.0;
 328          X : Real;
 329          Actual, Expected : Real;
 330          Sum, Em, X_Squared : Real;
 331       begin
 332          if Real'Digits > 19 then
 333             -- Taylor series calculation produces result accurate to 19
 334             -- digits.  If type being tested has more digits then set
 335             -- the error low bound to account for this.
 336             -- The error low bound is conservatively set to 6*10**-19
 337             Error_Low_Bound := 0.00000_00000_00000_0006;
 338             Report.Comment ("arctan accuracy checked to 19 digits");
 339          end if;
 340
 341          Accuracy_Error_Reported := False;  -- reset
 342          for I in 0..Max_Samples loop
 343             X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
 344             X_Squared := X * X;
 345             Em := 17.0;
 346             Sum := X_Squared / Em;
 347
 348             for II in 1 .. 7 loop
 349                Em := Em - 2.0;
 350                Sum := (1.0 / Em - Sum) * X_Squared;
 351             end loop;
 352             Sum := -X * Sum;
 353             Expected := X + Sum;
 354             Sum := (X - Expected) + Sum;
 355             if not Real'Machine_Rounds then
 356                Expected := Expected + (Sum + Sum);
 357             end if;
 358
 359             Actual := Arctan (X);
 360
 361             Check (Actual, Expected,
 362                    "Taylor_Series_Test " & Integer'Image (I) & ": arctan(" &
 363                    Real'Image (X) & ") ",
 364                    6.0);
 365
 366             if Accuracy_Error_Reported then
 367               -- only report the first error in this test in order to keep
 368               -- lots of failures from producing a huge error log
 369               return;
 370             end if;
 371
 372          end loop;
 373          Error_Low_Bound := 0.0;  -- reset
 374       exception
 375          when Constraint_Error =>
 376             Report.Failed
 377                ("Constraint_Error raised in Taylor_Series_Test");
 378          when others =>
 379             Report.Failed ("exception in Taylor_Series_Test");
 380       end Taylor_Series_Test;
 381
 382
 383       procedure Exception_Test is
 384          X1, X2, X3 : Real := 0.0;
 385       begin
 386
 387          begin  -- A.5.1(20);6.0
 388            X1 := Arctan(0.0, Cycle => 0.0);
 389            Report.Failed ("no exception for cycle = 0.0");
 390          exception
 391             when Ada.Numerics.Argument_Error => null;
 392             when others =>
 393                Report.Failed ("wrong exception for cycle = 0.0");
 394          end;
 395
 396          begin  -- A.5.1(20);6.0
 397            X2 := Arctan (0.0, Cycle => -1.0);
 398            Report.Failed ("no exception for cycle < 0.0");
 399          exception
 400             when Ada.Numerics.Argument_Error => null;
 401             when others =>
 402                Report.Failed ("wrong exception for cycle < 0.0");
 403          end;
 404
 405          begin  -- A.5.1(25);6.0
 406            X3 := Arctan (0.0, 0.0);
 407            Report.Failed ("no exception for arctan(0,0)");
 408          exception
 409             when Ada.Numerics.Argument_Error => null;
 410             when others =>
 411                Report.Failed ("wrong exception for arctan(0,0)");
 412          end;
 413
 414          -- optimizer thwarting
 415          if Report.Ident_Bool (False) then
 416             Report.Comment (Real'Image (X1 + X2 + X3));
 417          end if;
 418       end Exception_Test;
 419
 420
 421       procedure Do_Test is
 422       begin
 423          Special_Value_Test;
 424          Exact_Result_Test;
 425          Taylor_Series_Test;
 426          Exception_Test;
 427       end Do_Test;
 428    end Generic_Check;
 429
 430    -----------------------------------------------------------------------
 431    -----------------------------------------------------------------------
 432    -- These expressions must be truly static, which is why we have to do them
 433    -- outside of the generic, and we use the named numbers. Note that we know
 434    -- that PI is not a machine number (it is irrational), and it should be
 435    -- represented to more digits than supported by the target machine.
 436    Float_Half_PI_Low  : constant := Float'Adjacent(PI/2.0,  0.0);
 437    Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0);
 438    Float_PI_Low       : constant := Float'Adjacent(PI,      0.0);
 439    Float_PI_High      : constant := Float'Adjacent(PI,     10.0);
 440    package Float_Check is new Generic_Check (Float,
 441         Half_PI_Low  => Float_Half_PI_Low,
 442         Half_PI_High => Float_Half_PI_High,
 443         PI_Low  => Float_PI_Low,
 444         PI_High => Float_PI_High);
 445
 446    -- check the Floating point type with the most digits
 447    type A_Long_Float is digits System.Max_Digits;
 448    A_Long_Float_Half_PI_Low  : constant := A_Long_Float'Adjacent(PI/2.0,  0.0);
 449    A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0);
 450    A_Long_Float_PI_Low       : constant := A_Long_Float'Adjacent(PI,      0.0);
 451    A_Long_Float_PI_High      : constant := A_Long_Float'Adjacent(PI,     10.0);
 452    package A_Long_Float_Check is new Generic_Check (A_Long_Float,
 453         Half_PI_Low  => A_Long_Float_Half_PI_Low,
 454         Half_PI_High => A_Long_Float_Half_PI_High,
 455         PI_Low  => A_Long_Float_PI_Low,
 456         PI_High => A_Long_Float_PI_High);
 457
 458    -----------------------------------------------------------------------
 459    -----------------------------------------------------------------------
 460
 461
 462 begin
 463    Report.Test ("CXG2016",
 464                 "Check the accuracy of the ARCTAN function");
 465
 466    if Verbose then
 467       Report.Comment ("checking Standard.Float");
 468    end if;
 469
 470    Float_Check.Do_Test;
 471
 472    if Verbose then
 473       Report.Comment ("checking a digits" &
 474                       Integer'Image (System.Max_Digits) &
 475                       " floating point type");
 476    end if;
 477
 478    A_Long_Float_Check.Do_Test;
 479
 480
 481    Report.Result;
 482 end CXG2016;