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

   1 -- CXG1004.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 specified exceptions are raised by the subprograms
  28 --      defined in package Ada.Numerics.Generic_Complex_Elementary_Functions
  29 --      given the prescribed input parameter values.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      This test checks that specific subprograms defined in the
  33 --      package Ada.Numerics.Generic_Complex_Elementary_Functions raise the
  34 --      exceptions Argument_Error and Constraint_Error when their input
  35 --      parameter value are those specified as causing each exception.
  36 --      In the case of Constraint_Error, the exception will be raised in
  37 --      each test case, provided that the value of the attribute
  38 --      'Machine_Overflows (for the actual type of package
  39 --      Generic_Complex_Type) is True.
  40 --
  41 -- APPLICABILITY CRITERIA:
  42 --      This test only applies to implementations supporting the
  43 --      numerics annex.
  44 --
  45 --
  46 -- CHANGE HISTORY:
  47 --      06 Dec 94   SAIC    ACVC 2.0
  48 --      16 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
  49 --      29 Sep 96   SAIC    Incorporated reviewer comments.
  50 --      02 Jun 98   EDS     Replace "_i" with "_One".
  51 --!
  52
  53 with Ada.Numerics.Generic_Complex_Types;
  54 with Ada.Numerics.Generic_Complex_Elementary_Functions;
  55 with Report;
  56
  57 procedure CXG1004 is
  58 begin
  59
  60    Report.Test ("CXG1004", "Check that the specified exceptions are "      &
  61                            "raised by the subprograms defined in package " &
  62                            "Ada.Numerics.Generic_Complex_Elementary_"      &
  63                            "Functions given the prescribed input "         &
  64                            "parameter values");
  65
  66    Test_Block:
  67    declare
  68
  69       type Real_Type is new Float;
  70
  71       TC_Overflows : Boolean := Real_Type'Machine_Overflows;
  72
  73       package Complex_Pack is
  74         new Ada.Numerics.Generic_Complex_Types(Real_Type);
  75
  76       package CEF is
  77         new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack);
  78
  79       use Ada.Numerics, Complex_Pack, CEF;
  80
  81       Complex_Zero : constant Complex := Compose_From_Cartesian(0.0, 0.0);
  82       Plus_One     : constant Complex := Compose_From_Cartesian(1.0, 0.0);
  83       Minus_One    : constant Complex := Compose_From_Cartesian(-1.0, 0.0);
  84       Plus_i       : constant Complex := Compose_From_Cartesian(i);
  85       Minus_i      : constant Complex := Compose_From_Cartesian(-i);
  86
  87       Complex_Negative_Real      : constant Complex :=
  88                                             Compose_From_Cartesian(-4.0, 2.0);
  89       Complex_Negative_Imaginary : constant Complex :=
  90                                             Compose_From_Cartesian(3.0, -5.0);
  91
  92       TC_Complex   : Complex;
  93
  94
  95       -- This procedure is used in "Exception Raising" calls below in an
  96       -- attempt to avoid elimination of the subtest through optimization.
  97
  98       procedure No_Optimize (The_Complex_Number : Complex) is
  99       begin
 100          Report.Comment("No Optimize: Should never be printed " &
 101                         Integer'Image(Integer(The_Complex_Number.Im)));
 102       end No_Optimize;
 103
 104
 105    begin
 106
 107       -- Check that the exception Numerics.Argument_Error is raised by the
 108       -- exponentiation operator when the value of the left operand is zero,
 109       -- and the real component of the exponent (or the exponent itself) is
 110       -- zero.
 111
 112       begin
 113          TC_Complex := "**"(Left => Complex_Zero, Right => Complex_Zero);
 114          Report.Failed("Argument_Error not raised by exponentiation "  &
 115                        "operator, left operand = complex zero, right " &
 116                        "operand = complex zero");
 117          No_Optimize(TC_Complex);
 118       exception
 119          when Argument_Error => null;  -- OK, expected exception.
 120          when others =>
 121             Report.Failed("Incorrect exception raised by exponentiation " &
 122                           "operator, left operand = complex zero, right " &
 123                           "operand = complex zero");
 124       end;
 125
 126       begin
 127          TC_Complex := Complex_Zero**0.0;
 128          Report.Failed("Argument_Error not raised by exponentiation "  &
 129                        "operator, left operand = complex zero, right " &
 130                        "operand = real zero");
 131          No_Optimize(TC_Complex);
 132       exception
 133          when Argument_Error => null;  -- OK, expected exception.
 134          when others =>
 135             Report.Failed("Incorrect exception raised by exponentiation " &
 136                           "operator, left operand = complex zero, right " &
 137                           "operand = real zero");
 138       end;
 139
 140
 141       begin
 142          TC_Complex := "**"(Left => 0.0, Right => Complex_Zero);
 143          Report.Failed("Argument_Error not raised by exponentiation " &
 144                        "operator, left operand = real zero, right "   &
 145                        "operand = complex zero");
 146          No_Optimize(TC_Complex);
 147       exception
 148          when Argument_Error => null;  -- OK, expected exception.
 149          when others =>
 150             Report.Failed("Incorrect exception raised by exponentiation " &
 151                           "operator, left operand = real zero, right "    &
 152                           "operand = complex zero");
 153       end;
 154
 155
 156       -- Check that the exception Constraint_Error is raised under the
 157       -- specified circumstances, provided that
 158       -- Complex_Types.Real'Machine_Overflows is True.
 159
 160       if TC_Overflows then
 161
 162          -- Raised by Log, when the value of the parameter X is zero.
 163          begin
 164             TC_Complex := Log (X => Complex_Zero);
 165             Report.Failed("Constraint_Error not raised when Function " &
 166                           "Log given parameter value of complex zero");
 167             No_Optimize(TC_Complex);
 168          exception
 169             when Constraint_Error => null;  -- OK, expected exception.
 170             when others =>
 171                Report.Failed("Incorrect exception raised when Function " &
 172                              "Log given parameter value of complex zero");
 173          end;
 174
 175          -- Raised by Cot, when the value of the parameter X is zero.
 176          begin
 177             TC_Complex := Cot (X => Complex_Zero);
 178             Report.Failed("Constraint_Error not raised when Function " &
 179                           "Cot given parameter value of complex zero");
 180             No_Optimize(TC_Complex);
 181          exception
 182             when Constraint_Error => null;  -- OK, expected exception.
 183             when others =>
 184                Report.Failed("Incorrect exception raised when Function " &
 185                              "Cot given parameter value of complex zero");
 186          end;
 187
 188          -- Raised by Coth, when the value of the parameter X is zero.
 189          begin
 190             TC_Complex := Coth (Complex_Zero);
 191             Report.Failed("Constraint_Error not raised when Function " &
 192                           "Coth given parameter value of complex zero");
 193             No_Optimize(TC_Complex);
 194          exception
 195             when Constraint_Error => null;  -- OK, expected exception.
 196             when others =>
 197                Report.Failed("Incorrect exception raised when Function " &
 198                              "Coth given parameter value of complex zero");
 199          end;
 200
 201          -- Raised by the exponentiation operator, when the value of the
 202          -- left operand is zero and the real component of the exponent
 203          -- is negative.
 204          begin
 205             TC_Complex := Complex_Zero**Complex_Negative_Real;
 206             Report.Failed("Constraint_Error not raised when the "    &
 207                           "exponentiation operator left operand is " &
 208                           "complex zero, and the real component of " &
 209                           "the exponent is negative");
 210             No_Optimize(TC_Complex);
 211          exception
 212             when Constraint_Error => null;  -- OK, expected exception.
 213             when others =>
 214                Report.Failed("Incorrect exception raised when the "     &
 215                              "exponentiation operator left operand is " &
 216                              "complex zero, and the real component of " &
 217                              "the exponent is negative");
 218          end;
 219
 220          -- Raised by the exponentiation operator, when the value of the
 221          -- left operand is zero and the exponent itself (when it is of
 222          -- type real) is negative.
 223          declare
 224             Negative_Exponent : constant Real_Type := -4.0;
 225          begin
 226             TC_Complex := Complex_Zero**Negative_Exponent;
 227             Report.Failed("Constraint_Error not raised when the "    &
 228                           "exponentiation operator left operand is " &
 229                           "complex zero, and the real exponent is "  &
 230                           "negative");
 231             No_Optimize(TC_Complex);
 232          exception
 233             when Constraint_Error => null;  -- OK, expected exception.
 234             when others =>
 235                Report.Failed("Incorrect exception raised when the "     &
 236                              "exponentiation operator left operand is " &
 237                              "complex zero, and the real exponent is "  &
 238                              "negative");
 239          end;
 240
 241          -- Raised by Arctan, when the value of the parameter is +i.
 242          begin
 243             TC_Complex := Arctan (Plus_i);
 244             Report.Failed("Constraint_Error not raised when Function " &
 245                           "Arctan is given parameter value +i");
 246             No_Optimize(TC_Complex);
 247          exception
 248             when Constraint_Error => null;  -- OK, expected exception.
 249             when others =>
 250                Report.Failed("Incorrect exception raised when Function " &
 251                              "Arctan is given parameter value +i");
 252          end;
 253
 254          -- Raised by Arctan, when the value of the parameter is -i.
 255          begin
 256             TC_Complex := Arctan (Minus_i);
 257             Report.Failed("Constraint_Error not raised when Function " &
 258                           "Arctan is given parameter value -i");
 259             No_Optimize(TC_Complex);
 260          exception
 261             when Constraint_Error => null;  -- OK, expected exception.
 262             when others =>
 263                Report.Failed("Incorrect exception raised when Function " &
 264                              "Arctan is given parameter value -i");
 265          end;
 266
 267          -- Raised by Arccot, when the value of the parameter is +i.
 268          begin
 269             TC_Complex := Arccot (Plus_i);
 270             Report.Failed("Constraint_Error not raised when Function " &
 271                           "Arccot is given parameter value +i");
 272             No_Optimize(TC_Complex);
 273          exception
 274             when Constraint_Error => null;  -- OK, expected exception.
 275             when others =>
 276                Report.Failed("Incorrect exception raised when Function " &
 277                              "Arccot is given parameter value +i");
 278          end;
 279
 280          -- Raised by Arccot, when the value of the parameter is -i.
 281          begin
 282             TC_Complex := Arccot (Minus_i);
 283             Report.Failed("Constraint_Error not raised when Function " &
 284                           "Arccot is given parameter value -i");
 285             No_Optimize(TC_Complex);
 286          exception
 287             when Constraint_Error => null;  -- OK, expected exception.
 288             when others =>
 289                Report.Failed("Incorrect exception raised when Function " &
 290                              "Arccot is given parameter value -i");
 291          end;
 292
 293          -- Raised by Arctanh, when the value of the parameter is +1.
 294          begin
 295             TC_Complex := Arctanh (Plus_One);
 296             Report.Failed("Constraint_Error not raised when Function " &
 297                           "Arctanh is given parameter value +1");
 298             No_Optimize(TC_Complex);
 299          exception
 300             when Constraint_Error => null;  -- OK, expected exception.
 301             when others =>
 302                Report.Failed("Incorrect exception raised when Function " &
 303                              "Arctanh is given parameter value +1");
 304          end;
 305
 306          -- Raised by Arctanh, when the value of the parameter is -1.
 307          begin
 308             TC_Complex := Arctanh (Minus_One);
 309             Report.Failed("Constraint_Error not raised when Function " &
 310                           "Arctanh is given parameter value -1");
 311             No_Optimize(TC_Complex);
 312          exception
 313             when Constraint_Error => null;  -- OK, expected exception.
 314             when others =>
 315                Report.Failed("Incorrect exception raised when Function " &
 316                              "Arctanh is given parameter value -1");
 317          end;
 318
 319          -- Raised by Arccoth, when the value of the parameter is +1.
 320          begin
 321             TC_Complex := Arccoth (Plus_One);
 322             Report.Failed("Constraint_Error not raised when Function " &
 323                           "Arccoth is given parameter value +1");
 324             No_Optimize(TC_Complex);
 325          exception
 326             when Constraint_Error => null;  -- OK, expected exception.
 327             when others =>
 328                Report.Failed("Incorrect exception raised when Function " &
 329                              "Arccoth is given parameter value +1");
 330          end;
 331
 332          -- Raised by Arccoth, when the value of the parameter is -1.
 333          begin
 334             TC_Complex := Arccoth (Minus_One);
 335             Report.Failed("Constraint_Error not raised when Function " &
 336                           "Arccoth is given parameter value -1");
 337             No_Optimize(TC_Complex);
 338          exception
 339             when Constraint_Error => null;  -- OK, expected exception.
 340             when others =>
 341                Report.Failed("Incorrect exception raised when Function " &
 342                              "Arccoth is given parameter value -1");
 343          end;
 344
 345       else
 346          Report.Comment
 347            ("Attribute Complex_Pack.Real'Machine_Overflows is False; " &
 348             "evaluation of the complex elementary functions under "    &
 349             "specified circumstances was not performed");
 350       end if;
 351
 352
 353    exception
 354       when others =>
 355         Report.Failed ("Unexpected exception raised in Test_Block");
 356    end Test_Block;
 357
 358    Report.Result;
 359
 360 end CXG1004;