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

   1 -- CXG2002.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 "abs" or modulus function returns
  28 --      results that are within the error bound allowed.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      This test uses a generic package to compute and check the
  32 --      values of the modulus function.  In addition, a non-generic
  33 --      copy of this package is used to check the non-generic package
  34 --      Ada.Numerics.Complex_Types.
  35 --      Of special interest is the case where either the real or
  36 --      the imaginary part of the argument is very large while the
  37 --      other part is very small or 0.
  38 --      We want to check that the value is computed such that
  39 --      an overflow does not occur.  If computed directly from the
  40 --      definition
  41 --        abs (x+yi) = sqrt(x**2 + y**2)
  42 --      then overflow or underflow is much more likely than if the
  43 --      argument is normalized first.
  44 --
  45 -- SPECIAL REQUIREMENTS
  46 --      The Strict Mode for the numerical accuracy must be
  47 --      selected.  The method by which this mode is selected
  48 --      is implementation dependent.
  49 --
  50 -- APPLICABILITY CRITERIA:
  51 --      This test applies only to implementations supporting the
  52 --      Numerics Annex.
  53 --      This test only applies to the Strict Mode for numerical
  54 --      accuracy.
  55 --
  56 --
  57 -- CHANGE HISTORY:
  58 --      31 JAN 96   SAIC    Initial release for 2.1
  59 --      02 JUN 98   EDS     Add parens to intermediate calculations.
  60 --!
  61
  62 --
  63 -- Reference:
  64 -- Problems and Methodologies in Mathematical Software Production;
  65 -- editors: P. C. Messina and A Murli;
  66 -- Lecture Notes in Computer Science
  67 -- Volume 142
  68 -- Springer Verlag 1982
  69 --
  70
  71 with System;
  72 with Report;
  73 with Ada.Numerics.Generic_Complex_Types;
  74 with Ada.Numerics.Complex_Types;
  75 procedure CXG2002 is
  76    Verbose : constant Boolean := False;
  77    Maximum_Relative_Error : constant := 3.0;
  78
  79    generic
  80       type Real is digits <>;
  81    package Generic_Check is
  82       procedure Do_Test;
  83    end Generic_Check;
  84
  85    package body Generic_Check is
  86       package Complex_Types is new
  87            Ada.Numerics.Generic_Complex_Types (Real);
  88       use Complex_Types;
  89
  90       procedure Check (Actual, Expected : Real;
  91                        Test_Name : String;
  92                        MRE : Real := Maximum_Relative_Error) is
  93          Rel_Error,
  94          Abs_Error,
  95          Max_Error : Real;
  96       begin
  97          -- In the case where the expected result is very small or 0
  98          -- we compute the maximum error as a multiple of Model_Epsilon instead
  99          -- of Model_Epsilon and Expected.
 100          Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
 101          Abs_Error := MRE * Real'Model_Epsilon;
 102          if Rel_Error > Abs_Error then
 103             Max_Error := Rel_Error;
 104          else
 105             Max_Error := Abs_Error;
 106          end if;
 107
 108          if abs (Actual - Expected) > Max_Error then
 109             Report.Failed (Test_Name &
 110                            " actual: " & Real'Image (Actual) &
 111                            " expected: " & Real'Image (Expected) &
 112                            " difference: " &
 113                            Real'Image (Expected - Actual) &
 114                            " max_err:" & Real'Image (Max_Error) );
 115          elsif Verbose then
 116             if Actual = Expected then
 117                Report.Comment (Test_Name & "  exact result");
 118             else
 119                Report.Comment (Test_Name & "  passed");
 120             end if;
 121          end if;
 122       end Check;
 123
 124
 125       procedure Do_Test is
 126          Z : Complex;
 127          X : Real;
 128          T : Real;
 129       begin
 130
 131          --- test 1 ---
 132          begin
 133             T := Real'Safe_Last;
 134             Z := T + 0.0*i;
 135             X := abs Z;
 136             Check (X, T, "test 1 -- abs(bigreal + 0i)");
 137          exception
 138             when Constraint_Error =>
 139                Report.Failed ("Constraint_Error raised in test 1");
 140             when others =>
 141                Report.Failed ("exception in test 1");
 142          end;
 143
 144          --- test 2 ---
 145          begin
 146             T := Real'Safe_Last;
 147             Z := 0.0 + T*i;
 148             X := Modulus (Z);
 149             Check (X, T, "test 2 -- abs(0 + bigreal*i)");
 150          exception
 151             when Constraint_Error =>
 152                Report.Failed ("Constraint_Error raised in test 2");
 153             when others =>
 154                Report.Failed ("exception in test 2");
 155          end;
 156
 157          --- test 3 ---
 158          begin
 159             Z := 3.0 + 4.0*i;
 160             X := abs Z;
 161             Check (X, 5.0 , "test 3 -- abs(3 + 4*i)");
 162          exception
 163             when Constraint_Error =>
 164                Report.Failed ("Constraint_Error raised in test 3");
 165             when others =>
 166                Report.Failed ("exception in test 3");
 167          end;
 168
 169          --- test 4 ---
 170          declare
 171             S : Real;
 172          begin
 173             S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3);
 174             Z := 3.0 * S + 4.0*S*i;
 175             X := abs Z;
 176             Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S",
 177                    5.0*Real'Model_Epsilon);
 178          exception
 179             when Constraint_Error =>
 180                Report.Failed ("Constraint_Error raised in test 4");
 181             when others =>
 182                Report.Failed ("exception in test 4");
 183          end;
 184
 185          --- test 5 ---
 186          begin
 187             T := Real'Model_Small;
 188             Z := T + 0.0*i;
 189             X := abs Z;
 190             Check (X, T , "test 5 -- abs(small + 0*i)");
 191          exception
 192             when Constraint_Error =>
 193                Report.Failed ("Constraint_Error raised in test 5");
 194             when others =>
 195                Report.Failed ("exception in test 5");
 196          end;
 197
 198          --- test 6 ---
 199          begin
 200             T := Real'Model_Small;
 201             Z := 0.0 + T*i;
 202             X := abs Z;
 203             Check (X, T , "test 6 -- abs(0 + small*i)");
 204          exception
 205             when Constraint_Error =>
 206                Report.Failed ("Constraint_Error raised in test 6");
 207             when others =>
 208                Report.Failed ("exception in test 6");
 209          end;
 210
 211          --- test 7 ---
 212          declare
 213             S : Real;
 214          begin
 215             S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3);
 216             Z := 3.0 * S + 4.0*S*i;
 217             X := abs Z;
 218             Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S",
 219                    5.0*Real'Model_Epsilon);
 220          exception
 221             when Constraint_Error =>
 222                Report.Failed ("Constraint_Error raised in test 7");
 223             when others =>
 224                Report.Failed ("exception in test 7");
 225          end;
 226
 227          --- test 8 ---
 228          declare
 229             -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
 230             Sqrt2 : constant :=
 231               1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
 232          begin
 233             Z := 1.0 + 1.0*i;
 234             X := abs Z;
 235             Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)");
 236          exception
 237             when Constraint_Error =>
 238                Report.Failed ("Constraint_Error raised in test 8");
 239             when others =>
 240                Report.Failed ("exception in test 8");
 241          end;
 242
 243          --- test 9 ---
 244          begin
 245             T := 0.0;
 246             Z := T + 0.0*i;
 247             X := abs Z;
 248             Check (X, T , "test 5 -- abs(0 + 0*i)");
 249          exception
 250             when Constraint_Error =>
 251                Report.Failed ("Constraint_Error raised in test 9");
 252             when others =>
 253                Report.Failed ("exception in test 9");
 254          end;
 255       end Do_Test;
 256    end Generic_Check;
 257
 258    -----------------------------------------------------------------------
 259    --- non generic copy of the above generic package
 260    -----------------------------------------------------------------------
 261
 262    package Non_Generic_Check is
 263       subtype Real is Float;
 264       procedure Do_Test;
 265    end Non_Generic_Check;
 266
 267    package body Non_Generic_Check is
 268       use Ada.Numerics.Complex_Types;
 269
 270       procedure Check (Actual, Expected : Real;
 271                        Test_Name : String;
 272                        MRE : Real := Maximum_Relative_Error) is
 273          Rel_Error,
 274          Abs_Error,
 275          Max_Error : Real;
 276       begin
 277          -- In the case where the expected result is very small or 0
 278          -- we compute the maximum error as a multiple of Model_Epsilon instead
 279          -- of Model_Epsilon and Expected.
 280          Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
 281          Abs_Error := MRE * Real'Model_Epsilon;
 282          if Rel_Error > Abs_Error then
 283             Max_Error := Rel_Error;
 284          else
 285             Max_Error := Abs_Error;
 286          end if;
 287
 288          if abs (Actual - Expected) > Max_Error then
 289             Report.Failed (Test_Name &
 290                            " actual: " & Real'Image (Actual) &
 291                            " expected: " & Real'Image (Expected) &
 292                            " difference: " &
 293                            Real'Image (Expected - Actual) &
 294                            " max_err:" & Real'Image (Max_Error) );
 295          elsif Verbose then
 296             if Actual = Expected then
 297                Report.Comment (Test_Name & "  exact result");
 298             else
 299                Report.Comment (Test_Name & "  passed");
 300             end if;
 301          end if;
 302       end Check;
 303
 304
 305       procedure Do_Test is
 306          Z : Complex;
 307          X : Real;
 308          T : Real;
 309       begin
 310
 311          --- test 1 ---
 312          begin
 313             T := Real'Safe_Last;
 314             Z := T + 0.0*i;
 315             X := abs Z;
 316             Check (X, T, "test 1 -- abs(bigreal + 0i)");
 317          exception
 318             when Constraint_Error =>
 319                Report.Failed ("Constraint_Error raised in test 1");
 320             when others =>
 321                Report.Failed ("exception in test 1");
 322          end;
 323
 324          --- test 2 ---
 325          begin
 326             T := Real'Safe_Last;
 327             Z := 0.0 + T*i;
 328             X := Modulus (Z);
 329             Check (X, T, "test 2 -- abs(0 + bigreal*i)");
 330          exception
 331             when Constraint_Error =>
 332                Report.Failed ("Constraint_Error raised in test 2");
 333             when others =>
 334                Report.Failed ("exception in test 2");
 335          end;
 336
 337          --- test 3 ---
 338          begin
 339             Z := 3.0 + 4.0*i;
 340             X := abs Z;
 341             Check (X, 5.0 , "test 3 -- abs(3 + 4*i)");
 342          exception
 343             when Constraint_Error =>
 344                Report.Failed ("Constraint_Error raised in test 3");
 345             when others =>
 346                Report.Failed ("exception in test 3");
 347          end;
 348
 349          --- test 4 ---
 350          declare
 351             S : Real;
 352          begin
 353             S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3);
 354             Z := 3.0 * S + 4.0*S*i;
 355             X := abs Z;
 356             Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S",
 357                    5.0*Real'Model_Epsilon);
 358          exception
 359             when Constraint_Error =>
 360                Report.Failed ("Constraint_Error raised in test 4");
 361             when others =>
 362                Report.Failed ("exception in test 4");
 363          end;
 364
 365          --- test 5 ---
 366          begin
 367             T := Real'Model_Small;
 368             Z := T + 0.0*i;
 369             X := abs Z;
 370             Check (X, T , "test 5 -- abs(small + 0*i)");
 371          exception
 372             when Constraint_Error =>
 373                Report.Failed ("Constraint_Error raised in test 5");
 374             when others =>
 375                Report.Failed ("exception in test 5");
 376          end;
 377
 378          --- test 6 ---
 379          begin
 380             T := Real'Model_Small;
 381             Z := 0.0 + T*i;
 382             X := abs Z;
 383             Check (X, T , "test 6 -- abs(0 + small*i)");
 384          exception
 385             when Constraint_Error =>
 386                Report.Failed ("Constraint_Error raised in test 6");
 387             when others =>
 388                Report.Failed ("exception in test 6");
 389          end;
 390
 391          --- test 7 ---
 392          declare
 393             S : Real;
 394          begin
 395             S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3);
 396             Z := 3.0 * S + 4.0*S*i;
 397             X := abs Z;
 398             Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S",
 399                    5.0*Real'Model_Epsilon);
 400          exception
 401             when Constraint_Error =>
 402                Report.Failed ("Constraint_Error raised in test 7");
 403             when others =>
 404                Report.Failed ("exception in test 7");
 405          end;
 406
 407          --- test 8 ---
 408          declare
 409             -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
 410             Sqrt2 : constant :=
 411               1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
 412          begin
 413             Z := 1.0 + 1.0*i;
 414             X := abs Z;
 415             Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)");
 416          exception
 417             when Constraint_Error =>
 418                Report.Failed ("Constraint_Error raised in test 8");
 419             when others =>
 420                Report.Failed ("exception in test 8");
 421          end;
 422
 423          --- test 9 ---
 424          begin
 425             T := 0.0;
 426             Z := T + 0.0*i;
 427             X := abs Z;
 428             Check (X, T , "test 5 -- abs(0 + 0*i)");
 429          exception
 430             when Constraint_Error =>
 431                Report.Failed ("Constraint_Error raised in test 9");
 432             when others =>
 433                Report.Failed ("exception in test 9");
 434          end;
 435       end Do_Test;
 436    end Non_Generic_Check;
 437
 438    -----------------------------------------------------------------------
 439    --- end of "manual instantiation"
 440    -----------------------------------------------------------------------
 441    package Chk_Float is new Generic_Check (Float);
 442
 443    -- check the floating point type with the most digits
 444    type A_Long_Float is digits System.Max_Digits;
 445    package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
 446 begin
 447    Report.Test ("CXG2002",
 448                 "Check the accuracy of the complex modulus" &
 449                 " function");
 450
 451    if Verbose then
 452       Report.Comment ("checking Standard.Float");
 453    end if;
 454    Chk_Float.Do_Test;
 455
 456    if Verbose then
 457       Report.Comment ("checking a digits" &
 458                       Integer'Image (System.Max_Digits) &
 459                       " floating point type");
 460    end if;
 461    Chk_A_Long_Float.Do_Test;
 462
 463    if Verbose then
 464       Report.Comment ("checking non-generic package");
 465    end if;
 466    Non_Generic_Check.Do_Test;
 467    Report.Result;
 468 end CXG2002;