old-autovect-branch/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a

   1 -- CXG2007.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 Compose_From_Polar 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 Compose_From_Polar function.
  35 --
  36 -- SPECIAL REQUIREMENTS
  37 --      The Strict Mode for the numerical accuracy must be
  38 --      selected.  The method by which this mode is selected
  39 --      is implementation dependent.
  40 --
  41 -- APPLICABILITY CRITERIA:
  42 --      This test applies only to implementations supporting the
  43 --      Numerics Annex.
  44 --      This test only applies to the Strict Mode for numerical
  45 --      accuracy.
  46 --
  47 --
  48 -- CHANGE HISTORY:
  49 --      23 FEB 96   SAIC    Initial release for 2.1
  50 --      23 APR 96   SAIC    Fixed error checking
  51 --      03 MAR 97   PWB.CTA Deleted checks with explicit Cycle => 2.0*Pi
  52 --
  53 -- CHANGE NOTE:
  54 --      According to Ken Dritz, author of the Numerics Annex of the RM,
  55 --      one should never specify the cycle 2.0*Pi for the trigonometric
  56 --      functions.  In particular, if the machine number for the first
  57 --      argument is not an exact multiple of the machine number for the
  58 --      explicit cycle, then the specified exact results cannot be
  59 --      reasonably expected.  The affected checks in this test have been
  60 --      marked as comments, with the additional notation "pwb-math".
  61 --      Phil Brashear
  62 --!
  63
  64 with System;
  65 with Report;
  66 with Ada.Numerics;
  67 with Ada.Numerics.Generic_Complex_Types;
  68 procedure CXG2007 is
  69    Verbose : constant Boolean := False;
  70
  71
  72    -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
  73    Sqrt2 : constant :=
  74         1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
  75    Sqrt3 : constant :=
  76         1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
  77
  78    Pi : constant := Ada.Numerics.Pi;
  79
  80    generic
  81       type Real is digits <>;
  82    package Generic_Check is
  83       procedure Do_Test;
  84    end Generic_Check;
  85
  86    package body Generic_Check is
  87       package Complex_Types is new
  88            Ada.Numerics.Generic_Complex_Types (Real);
  89       use Complex_Types;
  90
  91       Maximum_Relative_Error : constant Real := 3.0;
  92
  93       procedure Check (Actual, Expected : Real;
  94                        Test_Name : String;
  95                        MRE : Real;
  96                        Arg_Error : Real) is
  97          -- Arg_Error is additional absolute error that is allowed beyond
  98          -- the MRE to account for error in the result that can be
  99          -- attributed to error in the arguments.
 100          Max_Error : Real;
 101          Rel_Error : Real;
 102          Abs_Error : Real;
 103       begin
 104          -- In the case where the expected result is very small or 0
 105          -- we compute the maximum error as a multiple of Model_Small instead
 106          -- of Model_Epsilon and Expected.
 107          Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
 108          Abs_Error := MRE * Real'Model_Epsilon;
 109          if Rel_Error > Abs_Error then
 110             Max_Error := Rel_Error;
 111          else
 112             Max_Error := Abs_Error;
 113          end if;
 114          Max_Error := Max_Error + Arg_Error;
 115
 116          if abs (Actual - Expected) > Max_Error then
 117             Report.Failed (Test_Name &
 118                            " actual: " & Real'Image (Actual) &
 119                            " expected: " & Real'Image (Expected) &
 120                            " difference: " & Real'Image (Actual - Expected) &
 121                            " max err:" & Real'Image (Max_Error) );
 122          elsif Verbose then
 123             if Actual = Expected then
 124                Report.Comment (Test_Name & "  exact result");
 125             else
 126                Report.Comment (Test_Name & "  passed");
 127             end if;
 128          end if;
 129       end Check;
 130
 131
 132       procedure Check (Actual, Expected : Complex;
 133                        Test_Name : String;
 134                        MRE : Real;
 135                        Arg_Error : Real) is
 136          -- Arg_Error is additional absolute error that is allowed beyond
 137          -- the MRE to account for error in the result that can be
 138          -- attributed to error in the arguments.
 139       begin
 140          Check (Actual.Re, Expected.Re,
 141                 Test_Name & " real part",
 142                 MRE, Arg_Error);
 143          Check (Actual.Im, Expected.Im,
 144                 Test_Name & " imaginary part",
 145                 MRE, Arg_Error);
 146       end Check;
 147
 148
 149       procedure Special_Cases is
 150          type Data_Point is
 151             record
 152                Re,
 153                Im,
 154                Modulus,
 155                Radians,
 156                Degrees,
 157                Arg_Error : Real;
 158             end record;
 159
 160          -- shorthand names for various constants
 161          P4 : constant := Pi/4.0;
 162          P6 : constant := Pi/6.0;
 163
 164          MER2 : constant Real := Real'Model_Epsilon * Sqrt2;
 165
 166          type Test_Data_Type is array (Positive range <>) of Data_Point;
 167
 168          -- the values in the following table only involve static
 169          -- expressions so no loss of precision occurs.
 170          Test_Data : constant Test_Data_Type := (
 171          --Re          Im   Modulus     Radians  Degrees  Arg_Err
 172          ( 0.0,        0.0, 0.0,            0.0,   0.0,    0.0 ),    -- 1
 173          ( 0.0,        0.0, 0.0,             Pi, 180.0,    0.0 ),    -- 2
 174
 175          ( 1.0,        0.0, 1.0,            0.0,   0.0,    0.0 ),    -- 3
 176          (-1.0,        0.0, -1.0,           0.0,   0.0,    0.0 ),    -- 4
 177
 178          ( 1.0,        1.0,  Sqrt2,          P4,  45.0,    MER2),    -- 5
 179          (-1.0,        1.0, -Sqrt2,         -P4, -45.0,    MER2),    -- 6
 180          ( 1.0,       -1.0,  Sqrt2,         -P4, -45.0,    MER2),    -- 7
 181          (-1.0,       -1.0, -Sqrt2,          P4,  45.0,    MER2),    -- 8
 182          (-1.0,       -1.0,  Sqrt2,     -3.0*P4,-135.0,    MER2),    -- 9
 183          (-1.0,        1.0,  Sqrt2,      3.0*P4, 135.0,    MER2),    -- 10
 184          ( 1.0,       -1.0, -Sqrt2,      3.0*P4, 135.0,    MER2),    -- 11
 185
 186          (-1.0,        0.0, 1.0,             Pi, 180.0,    0.0 ),    -- 12
 187          ( 1.0,        0.0, -1.0,            Pi, 180.0,    0.0 ) );  -- 13
 188
 189
 190          Z : Complex;
 191          Exp : Complex;
 192       begin
 193          for I in Test_Data'Range loop
 194             begin
 195                Exp := (Test_Data (I).Re, Test_Data (I).Im);
 196
 197                Z := Compose_From_Polar (Test_Data (I).Modulus,
 198                                         Test_Data (I).Radians);
 199                Check (Z, Exp,
 200                  "test" & Integer'Image (I) & " compose_from_polar(m,r)",
 201                  Maximum_Relative_Error, Test_Data (I).Arg_Error);
 202
 203 --pwb-math               Z := Compose_From_Polar (Test_Data (I).Modulus,
 204 --pwb-math                                      Test_Data (I).Radians,
 205 --pwb-math                                      2.0*Pi);
 206 --pwb-math             Check (Z, Exp,
 207 --pwb-math                 "test" & Integer'Image (I) & " compose_from_polar(m,r,2pi)",
 208 --pwb-math               Maximum_Relative_Error, Test_Data (I).Arg_Error);
 209
 210                Z := Compose_From_Polar (Test_Data (I).Modulus,
 211                                         Test_Data (I).Degrees,
 212                                         360.0);
 213                Check (Z, Exp,
 214                  "test" & Integer'Image (I) & " compose_from_polar(m,d,360)",
 215                  Maximum_Relative_Error, Test_Data (I).Arg_Error);
 216
 217             exception
 218                when Constraint_Error =>
 219                   Report.Failed ("Constraint_Error raised in test" &
 220                       Integer'Image (I));
 221                when others =>
 222                   Report.Failed ("exception in test" &
 223                       Integer'Image (I));
 224             end;
 225          end loop;
 226       end Special_Cases;
 227
 228
 229       procedure Exception_Cases is
 230       -- check that Argument_Error is raised if Cycle is <= 0
 231          Z : Complex;
 232          W : Complex;
 233       begin
 234          begin
 235            Z := Compose_From_Polar (3.0, 0.0, Cycle => 0.0);
 236            Report.Failed ("no exception for cycle = 0.0");
 237          exception
 238             when Ada.Numerics.Argument_Error => null;
 239             when others =>
 240                Report.Failed ("wrong exception for cycle = 0.0");
 241          end;
 242
 243          begin
 244            W := Compose_From_Polar (6.0, 1.0, Cycle => -10.0);
 245            Report.Failed ("no exception for cycle < 0.0");
 246          exception
 247             when Ada.Numerics.Argument_Error => null;
 248             when others =>
 249                Report.Failed ("wrong exception for cycle < 0.0");
 250          end;
 251
 252          if Report.Ident_Int (1) = 2 then
 253              -- not executed - used to make it appear that we use the
 254              -- results of the above computation
 255              Z := Z * W;
 256              Report.Failed(Real'Image (Z.Re + Z.Im));
 257          end if;
 258       end Exception_Cases;
 259
 260
 261       procedure Do_Test is
 262       begin
 263          Special_Cases;
 264          Exception_Cases;
 265       end Do_Test;
 266    end Generic_Check;
 267
 268    package Chk_Float is new Generic_Check (Float);
 269
 270    -- check the floating point type with the most digits
 271    type A_Long_Float is digits System.Max_Digits;
 272    package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
 273 begin
 274    Report.Test ("CXG2007",
 275                 "Check the accuracy of the Compose_From_Polar" &
 276                 " function");
 277
 278    if Verbose then
 279       Report.Comment ("checking Standard.Float");
 280    end if;
 281    Chk_Float.Do_Test;
 282
 283    if Verbose then
 284       Report.Comment ("checking a digits" &
 285                       Integer'Image (System.Max_Digits) &
 286                       " floating point type");
 287    end if;
 288    Chk_A_Long_Float.Do_Test;
 289
 290    Report.Result;
 291 end CXG2007;