gcc/testsuite/ada/acats/tests/cxg/cxg2006.a

   1 -- CXG2006.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 complex Argument function returns
  28 --      results that are within the error bound allowed.
  29 --      Check that Argument_Error is raised if the Cycle parameter
  30 --      is less than or equal to zero.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      This test uses a generic package to compute and check the
  34 --      values of the Argument function.
  35 --      Of special interest is the case where either the real or
  36 --      the imaginary part of the parameter is very large while the
  37 --      other part is very small or 0.
  38 --
  39 -- SPECIAL REQUIREMENTS
  40 --      The Strict Mode for the numerical accuracy must be
  41 --      selected.  The method by which this mode is selected
  42 --      is implementation dependent.
  43 --
  44 -- APPLICABILITY CRITERIA:
  45 --      This test applies only to implementations supporting the
  46 --      Numerics Annex.
  47 --      This test only applies to the Strict Mode for numerical
  48 --      accuracy.
  49 --
  50 --
  51 -- CHANGE HISTORY:
  52 --      15 FEB 96   SAIC    Initial release for 2.1
  53 --      03 MAR 97   PWB.CTA Removed checks involving explicit cycle => 2.0*Pi
  54 --
  55 -- CHANGE NOTE:
  56 --      According to Ken Dritz, author of the Numerics Annex of the RM,
  57 --      one should never specify the cycle 2.0*Pi for the trigonometric
  58 --      functions.  In particular, if the machine number for the first
  59 --      argument is not an exact multiple of the machine number for the
  60 --      explicit cycle, then the specified exact results cannot be
  61 --      reasonably expected.  The affected checks in this test have been
  62 --      marked as comments, with the additional notation "pwb-math".
  63 --      Phil Brashear
  64 --!
  65
  66 --
  67 -- Reference:
  68 -- Problems and Methodologies in Mathematical Software Production;
  69 -- editors: P. C. Messina and A Murli;
  70 -- Lecture Notes in Computer Science
  71 -- Volume 142
  72 -- Springer Verlag 1982
  73 --
  74
  75 with System;
  76 with Report;
  77 with ImpDef.Annex_G;
  78 with Ada.Numerics;
  79 with Ada.Numerics.Generic_Complex_Types;
  80 with Ada.Numerics.Complex_Types;
  81 procedure CXG2006 is
  82    Verbose : constant Boolean := False;
  83
  84
  85    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
  86    Sqrt2 : constant :=
  87         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
  88    Sqrt3 : constant :=
  89         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
  90
  91    Pi : constant := Ada.Numerics.Pi;
  92
  93    generic
  94       type Real is digits <>;
  95    package Generic_Check is
  96       procedure Do_Test;
  97    end Generic_Check;
  98
  99    package body Generic_Check is
 100       package Complex_Types is new
 101            Ada.Numerics.Generic_Complex_Types (Real);
 102       use Complex_Types;
 103
 104
 105       procedure Check (Actual, Expected : Real;
 106                        Test_Name : String;
 107                        MRE : Real) is
 108          Rel_Error : Real;
 109          Abs_Error : Real;
 110          Max_Error : Real;
 111       begin
 112          -- In the case where the expected result is very small or 0
 113          -- we compute the maximum error as a multiple of Model_Epsilon instead
 114          -- of Model_Epsilon and Expected.
 115          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
 116          Abs_Error := MRE * Real'Model_Epsilon;
 117          if Rel_Error > Abs_Error then
 118             Max_Error := Rel_Error;
 119          else
 120             Max_Error := Abs_Error;
 121          end if;
 122
 123          if abs (Actual - Expected) > Max_Error then
 124             Report.Failed (Test_Name &
 125                            " actual: " & Real'Image (Actual) &
 126                            " expected: " & Real'Image (Expected) &
 127                            " difference: " &
 128                            Real'Image (Actual - Expected) &
 129                            " mre:" & Real'Image (Max_Error) );
 130          elsif Verbose then
 131             if Actual = Expected then
 132                Report.Comment (Test_Name & "  exact result");
 133             else
 134                Report.Comment (Test_Name & "  passed");
 135             end if;
 136          end if;
 137       end Check;
 138
 139
 140       procedure Special_Cases is
 141          type Data_Point is
 142             record
 143                Re,
 144                Im,
 145                Radians,
 146                Degrees,
 147                Error_Bound   : Real;
 148             end record;
 149
 150          type Test_Data_Type is array (Positive range <>) of Data_Point;
 151
 152          -- the values in the following table only involve static
 153          -- expressions to minimize errors in precision introduced by the
 154          -- test.  For cases where Pi is used in the argument we must
 155          -- allow an extra 1.0*MRE to account for roundoff error in the
 156          -- argument.  Where the result involves a square root we allow
 157          -- an extra 0.5*MRE to allow for roundoff error.
 158          Test_Data : constant Test_Data_Type := (
 159 --    Re               Im                     Radians  Degrees  Err    Test #
 160     (0.0,               0.0,                       0.0,   0.0,  4.0 ),  -- 1
 161     (1.0,               0.0,                       0.0,   0.0,  4.0 ),  -- 2
 162     (Real'Safe_Last,    0.0,                       0.0,   0.0,  4.0 ),  -- 3
 163     (Real'Model_Small,  0.0,                       0.0,   0.0,  4.0 ),  -- 4
 164     (1.0,               1.0,                    Pi/4.0,  45.0,  5.0 ),  -- 5
 165     (1.0,              -1.0,                   -Pi/4.0, -45.0,  5.0 ),  -- 6
 166     (-1.0,             -1.0,               -3.0*Pi/4.0,-135.0,  5.0 ),  -- 7
 167     (-1.0,              1.0,                3.0*Pi/4.0, 135.0,  5.0 ),  -- 8
 168     (Sqrt3,             1.0,                    Pi/6.0,  30.0,  5.5 ),  -- 9
 169     (-Sqrt3,            1.0,                5.0*Pi/6.0, 150.0,  5.5 ),  -- 10
 170     (Sqrt3,            -1.0,                   -Pi/6.0, -30.0,  5.5 ),  -- 11
 171     (-Sqrt3,           -1.0,               -5.0*Pi/6.0,-150.0,  5.5 ),  -- 12
 172     (Real'Model_Small,  Real'Model_Small,       Pi/4.0,  45.0,  5.0 ),  -- 13
 173     (-Real'Safe_Last,   0.0,                        Pi, 180.0,  5.0 ),  -- 14
 174     (-Real'Safe_Last,  -Real'Model_Small,          -Pi,-180.0,  5.0 ),  -- 15
 175     (100000.0,          100000.0,               Pi/4.0,  45.0,  5.0 )); -- 16
 176
 177          X : Real;
 178          Z : Complex;
 179       begin
 180          for I in Test_Data'Range loop
 181             begin
 182                Z := (Test_Data(I).Re, Test_Data(I).Im);
 183                X := Argument (Z);
 184                Check (X, Test_Data(I).Radians,
 185                    "test" & Integer'Image (I) & " argument(z)",
 186                    Test_Data (I).Error_Bound);
 187 --pwb-math               X := Argument (Z, 2.0*Pi);
 188 --pwb-math             Check (X, Test_Data(I).Radians,
 189 --pwb-math                   "test" & Integer'Image (I) & " argument(z, 2pi)",
 190 --pwb-math                   Test_Data (I).Error_Bound);
 191                X := Argument (Z, 360.0);
 192                Check (X, Test_Data(I).Degrees,
 193                    "test" & Integer'Image (I) & " argument(z, 360)",
 194                    Test_Data (I).Error_Bound);
 195
 196             exception
 197                when Constraint_Error =>
 198                   Report.Failed ("Constraint_Error raised in test" &
 199                       Integer'Image (I));
 200                when others =>
 201                   Report.Failed ("exception in test" &
 202                       Integer'Image (I));
 203             end;
 204          end loop;
 205
 206          if Real'Signed_Zeros then
 207             begin
 208               X := Argument ((-1.0, Real(ImpDef.Annex_G.Negative_Zero)));
 209               Check (X, -Pi, "test of arg((-1,-0)", 4.0);
 210             exception
 211                when others =>
 212                   Report.Failed ("exception in signed zero test");
 213             end;
 214          end if;
 215       end Special_Cases;
 216
 217
 218       procedure Exception_Cases is
 219       -- check that Argument_Error is raised if Cycle is <= 0
 220          Z : Complex := (1.0, 1.0);
 221          X : Real;
 222          Y : Real;
 223       begin
 224          begin
 225            X := Argument (Z, Cycle => 0.0);
 226            Report.Failed ("no exception for cycle = 0.0");
 227          exception
 228             when Ada.Numerics.Argument_Error => null;
 229             when others =>
 230                Report.Failed ("wrong exception for cycle = 0.0");
 231          end;
 232
 233          begin
 234            Y := Argument (Z, Cycle => -3.0);
 235            Report.Failed ("no exception for cycle < 0.0");
 236          exception
 237             when Ada.Numerics.Argument_Error => null;
 238             when others =>
 239                Report.Failed ("wrong exception for cycle < 0.0");
 240          end;
 241
 242          if Report.Ident_Int (2) = 1 then
 243             -- optimization thwarting code - never executed
 244             Report.Failed("2=1" & Real'Image (X+Y));
 245          end if;
 246       end Exception_Cases;
 247
 248
 249       procedure Do_Test is
 250       begin
 251          Special_Cases;
 252          Exception_Cases;
 253       end Do_Test;
 254    end Generic_Check;
 255
 256    package Chk_Float is new Generic_Check (Float);
 257
 258    -- check the floating point type with the most digits
 259    type A_Long_Float is digits System.Max_Digits;
 260    package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
 261 begin
 262    Report.Test ("CXG2006",
 263                 "Check the accuracy of the complex argument" &
 264                 " function");
 265
 266    if Verbose then
 267       Report.Comment ("checking Standard.Float");
 268    end if;
 269
 270    Chk_Float.Do_Test;
 271
 272    if Verbose then
 273       Report.Comment ("checking a digits" &
 274                       Integer'Image (System.Max_Digits) &
 275                       " floating point type");
 276    end if;
 277
 278    Chk_A_Long_Float.Do_Test;
 279
 280    Report.Result;
 281 end CXG2006;