old-autovect-branch/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a

   1 -- CXF2A01.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 binary adding operators for a decimal fixed point type
  28 --      return values that are integral multiples of the small of the type.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      The test verifies that decimal addition and subtraction behave as
  32 --      expected for types with various digits, delta, and Machine_Radix
  33 --      values. Types with the minimum values for Decimal.Max_Digits and
  34 --      Decimal.Max_Scale (18) are included.
  35 --
  36 --      Two kinds of checks are performed for each type. In the first check,
  37 --      the iteration, operation, and operand counts in the foundation and
  38 --      the operation tables in this test are given values such that, when the
  39 --      operations loop is complete, each operand will have been added to and
  40 --      subtracted from the loop's cumulator variable the same number of times,
  41 --      albeit in varying order. Thus, the result returned by the operations
  42 --      loop should have the same value as that used to initialize the
  43 --      cumulator (in this test, zero).
  44 --
  45 --      In the second check, the same operation (addition for some types and
  46 --      subtraction for others) is performed during each loop iteration,
  47 --      resulting in a cumulative total which is checked against an expected
  48 --      value.
  49 --
  50 -- TEST FILES:
  51 --      The following files comprise this test:
  52 --
  53 --         FXF2A00.A
  54 --      -> CXF2A01.A
  55 --
  56 -- APPLICABILITY CRITERIA:
  57 --      This test is only applicable for a compiler attempting validation
  58 --      for the Information Systems Annex.
  59 --
  60 --
  61 -- CHANGE HISTORY:
  62 --      08 Apr 96   SAIC    Prerelease version for ACVC 2.1.
  63 --
  64 --!
  65
  66 package CXF2A01_0 is
  67
  68                ---=---=---=---=---=---=---=---=---=---=---
  69
  70    type Micro is delta 10.0**(-18) digits 18; -- range -0.999999999999999999 ..
  71    for Micro'Machine_Radix use 10;     --              +0.999999999999999999
  72
  73    function Add      (Left, Right : Micro) return Micro;
  74    function Subtract (Left, Right : Micro) return Micro;
  75
  76
  77    type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro;
  78
  79    Micro_Add : Micro_Optr_Ptr := Add'Access;
  80    Micro_Sub : Micro_Optr_Ptr := Subtract'Access;
  81
  82                ---=---=---=---=---=---=---=---=---=---=---
  83
  84    type Money is delta 0.01 digits 11; -- range -999,999,999.99 ..
  85    for Money'Machine_Radix use 2;      --       +999,999,999.99
  86
  87    function Add      (Left, Right : Money) return Money;
  88    function Subtract (Left, Right : Money) return Money;
  89
  90
  91    type Money_Optr_Ptr is access function (Left, Right : Money) return Money;
  92
  93    Money_Add : Money_Optr_Ptr := Add'Access;
  94    Money_Sub : Money_Optr_Ptr := Subtract'Access;
  95
  96                ---=---=---=---=---=---=---=---=---=---=---
  97
  98    -- Same as Money, but with Radix 10:
  99
 100    type Cash is delta 0.01 digits 11; -- range -999,999,999.99 ..
 101    for Cash'Machine_Radix use 10;     --       +999,999,999.99
 102
 103    function Add      (Left, Right : Cash) return Cash;
 104    function Subtract (Left, Right : Cash) return Cash;
 105
 106
 107    type Cash_Optr_Ptr is access function (Left, Right : Cash) return Cash;
 108
 109    Cash_Add : Cash_Optr_Ptr := Add'Access;
 110    Cash_Sub : Cash_Optr_Ptr := Subtract'Access;
 111
 112                ---=---=---=---=---=---=---=---=---=---=---
 113
 114    type Broad is delta 10.0**(-9) digits 18; -- range -999,999,999.999999999 ..
 115    for Broad'Machine_Radix use 10;           --       +999,999,999.999999999
 116
 117    function Add      (Left, Right : Broad) return Broad;
 118    function Subtract (Left, Right : Broad) return Broad;
 119
 120
 121    type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad;
 122
 123    Broad_Add : Broad_Optr_Ptr := Add'Access;
 124    Broad_Sub : Broad_Optr_Ptr := Subtract'Access;
 125
 126                ---=---=---=---=---=---=---=---=---=---=---
 127
 128 end CXF2A01_0;
 129
 130
 131      --==================================================================--
 132
 133
 134 package body CXF2A01_0 is
 135
 136                ---=---=---=---=---=---=---=---=---=---=---
 137
 138    function Add (Left, Right : Micro) return Micro is
 139    begin
 140       return (Left + Right); -- Decimal fixed addition.
 141    end Add;
 142
 143    function Subtract (Left, Right : Micro) return Micro is
 144    begin
 145       return (Left - Right); -- Decimal fixed subtraction.
 146    end Subtract;
 147
 148                ---=---=---=---=---=---=---=---=---=---=---
 149
 150    function Add (Left, Right : Money) return Money is
 151    begin
 152       return (Left + Right); -- Decimal fixed addition.
 153    end Add;
 154
 155    function Subtract (Left, Right : Money) return Money is
 156    begin
 157       return (Left - Right); -- Decimal fixed subtraction.
 158    end Subtract;
 159
 160                ---=---=---=---=---=---=---=---=---=---=---
 161
 162    function Add (Left, Right : Cash) return Cash is
 163    begin
 164       return (Left + Right); -- Decimal fixed addition.
 165    end Add;
 166
 167    function Subtract (Left, Right : Cash) return Cash is
 168    begin
 169       return (Left - Right); -- Decimal fixed subtraction.
 170    end Subtract;
 171
 172                ---=---=---=---=---=---=---=---=---=---=---
 173
 174    function Add (Left, Right : Broad) return Broad is
 175    begin
 176       return (Left + Right); -- Decimal fixed addition.
 177    end Add;
 178
 179    function Subtract (Left, Right : Broad) return Broad is
 180    begin
 181       return (Left - Right); -- Decimal fixed subtraction.
 182    end Subtract;
 183
 184                ---=---=---=---=---=---=---=---=---=---=---
 185
 186 end CXF2A01_0;
 187
 188
 189      --==================================================================--
 190
 191
 192 with FXF2A00;
 193 package CXF2A01_0.CXF2A01_1 is
 194
 195                ---=---=---=---=---=---=---=---=---=---=---
 196
 197    type Micro_Ops   is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr;
 198    type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro;
 199
 200    Micro_Optr_Table_Cancel : Micro_Ops   := ( Micro_Add, Micro_Sub,
 201                                               Micro_Add, Micro_Sub,
 202                                               Micro_Add, Micro_Sub );
 203
 204    Micro_Optr_Table_Cumul  : Micro_Ops   := ( others => Micro_Add );
 205
 206    Micro_Opnd_Table_Cancel : Micro_Opnds := ( 0.001025000235111997,
 207                                               0.000000000000000003,
 208                                               0.724902903219925400,
 209                                               0.000459228020000011,
 210                                               0.049832104921096533 );
 211
 212    Micro_Opnd_Table_Cumul  : Micro_Opnds := ( 0.000002309540000000,
 213                                               0.000000278060000000,
 214                                               0.000000000000070000,
 215                                               0.000010003000000000,
 216                                               0.000000023090000000 );
 217
 218    function Test_Micro_Ops is new FXF2A00.Operations_Loop
 219      (Decimal_Fixed  => Micro,
 220       Operator_Ptr   => Micro_Optr_Ptr,
 221       Operator_Table => Micro_Ops,
 222       Operand_Table  => Micro_Opnds);
 223
 224                ---=---=---=---=---=---=---=---=---=---=---
 225
 226    type Money_Ops   is array (FXF2A00.Optr_Range) of Money_Optr_Ptr;
 227    type Money_Opnds is array (FXF2A00.Opnd_Range) of Money;
 228
 229    Money_Optr_Table_Cancel : Money_Ops   := ( Money_Add, Money_Add,
 230                                               Money_Sub, Money_Add,
 231                                               Money_Sub, Money_Sub );
 232
 233    Money_Optr_Table_Cumul  : Money_Ops   := ( others => Money_Sub );
 234
 235    Money_Opnd_Table_Cancel  : Money_Opnds := (       127.10,
 236                                                     5600.44,
 237                                                        0.05,
 238                                                   189662.78,
 239                                                226900402.99  );
 240
 241    Money_Opnd_Table_Cumul   : Money_Opnds := (        17.99,
 242                                                      500.41,
 243                                                       92.78,
 244                                                        0.38,
 245                                                     2942.99  );
 246
 247    function Test_Money_Ops is new FXF2A00.Operations_Loop
 248      (Decimal_Fixed  => Money,
 249       Operator_Ptr   => Money_Optr_Ptr,
 250       Operator_Table => Money_Ops,
 251       Operand_Table  => Money_Opnds);
 252
 253                ---=---=---=---=---=---=---=---=---=---=---
 254
 255    type Cash_Ops   is array (FXF2A00.Optr_Range) of Cash_Optr_Ptr;
 256    type Cash_Opnds is array (FXF2A00.Opnd_Range) of Cash;
 257
 258    Cash_Optr_Table_Cancel : Cash_Ops   := ( Cash_Add, Cash_Add,
 259                                             Cash_Sub, Cash_Add,
 260                                             Cash_Sub, Cash_Sub );
 261
 262    Cash_Optr_Table_Cumul  : Cash_Ops   := ( others => Cash_Add );
 263
 264    Cash_Opnd_Table_Cancel : Cash_Opnds := (       127.10,
 265                                                  5600.44,
 266                                                     0.05,
 267                                                189662.78,
 268                                             226900402.99  );
 269
 270    Cash_Opnd_Table_Cumul  : Cash_Opnds := (         3.33,
 271                                                100056.14,
 272                                                    22.87,
 273                                                  3901.55,
 274                                                   111.21  );
 275
 276    function Test_Cash_Ops is new FXF2A00.Operations_Loop
 277      (Decimal_Fixed  => Cash,
 278       Operator_Ptr   => Cash_Optr_Ptr,
 279       Operator_Table => Cash_Ops,
 280       Operand_Table  => Cash_Opnds);
 281
 282                ---=---=---=---=---=---=---=---=---=---=---
 283
 284    type Broad_Ops   is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr;
 285    type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad;
 286
 287    Broad_Optr_Table_Cancel : Broad_Ops   := ( Broad_Sub, Broad_Add,
 288                                               Broad_Add, Broad_Sub,
 289                                               Broad_Sub, Broad_Add );
 290
 291    Broad_Optr_Table_Cumul  : Broad_Ops   := ( others => Broad_Sub );
 292
 293    Broad_Opnd_Table_Cancel : Broad_Opnds := (         1.000009092,
 294                                               732919479.445022293,
 295                                                   89662.787000006,
 296                                                     660.101010133,
 297                                                 1121127.999905594  );
 298
 299    Broad_Opnd_Table_Cumul  : Broad_Opnds := (        12.000450223,
 300                                                     479.430320780,
 301                                                       0.003492096,
 302                                                       8.112888400,
 303                                                    1002.994937800  );
 304
 305    function Test_Broad_Ops is new FXF2A00.Operations_Loop
 306      (Decimal_Fixed  => Broad,
 307       Operator_Ptr   => Broad_Optr_Ptr,
 308       Operator_Table => Broad_Ops,
 309       Operand_Table  => Broad_Opnds);
 310
 311                ---=---=---=---=---=---=---=---=---=---=---
 312
 313 end CXF2A01_0.CXF2A01_1;
 314
 315
 316      --==================================================================--
 317
 318
 319 with CXF2A01_0.CXF2A01_1;
 320
 321 with Report;
 322 procedure CXF2A01 is
 323    package Data renames CXF2A01_0.CXF2A01_1;
 324
 325    use type CXF2A01_0.Micro;
 326    use type CXF2A01_0.Money;
 327    use type CXF2A01_0.Cash;
 328    use type CXF2A01_0.Broad;
 329
 330    Micro_Cancel_Expected : constant CXF2A01_0.Micro := 0.0;
 331    Money_Cancel_Expected : constant CXF2A01_0.Money := 0.0;
 332    Cash_Cancel_Expected  : constant CXF2A01_0.Cash  := 0.0;
 333    Broad_Cancel_Expected : constant CXF2A01_0.Broad := 0.0;
 334
 335    Micro_Cumul_Expected  : constant CXF2A01_0.Micro :=  0.075682140420000000;
 336    Money_Cumul_Expected  : constant CXF2A01_0.Money := -21327300.00;
 337    Cash_Cumul_Expected   : constant CXF2A01_0.Cash  :=  624570600.00;
 338    Broad_Cumul_Expected  : constant CXF2A01_0.Broad := -9015252.535794000;
 339
 340    Micro_Actual   : CXF2A01_0.Micro;
 341    Money_Actual   : CXF2A01_0.Money;
 342    Cash_Actual    : CXF2A01_0.Cash;
 343    Broad_Actual   : CXF2A01_0.Broad;
 344 begin
 345
 346    Report.Test ("CXF2A01", "Check decimal addition and subtraction");
 347
 348
 349                ---=---=---=---=---=---=---=---=---=---=---
 350
 351
 352    Micro_Actual := Data.Test_Micro_Ops (0.0,
 353                                         Data.Micro_Optr_Table_Cancel,
 354                                         Data.Micro_Opnd_Table_Cancel);
 355
 356    if Micro_Actual /= Micro_Cancel_Expected then
 357       Report.Failed ("Wrong cancellation result for type Micro");
 358    end if;
 359
 360                        ---=---=---=---=---=---=---
 361
 362
 363    Micro_Actual := Data.Test_Micro_Ops (0.0,
 364                                         Data.Micro_Optr_Table_Cumul,
 365                                         Data.Micro_Opnd_Table_Cumul);
 366
 367    if Micro_Actual /= Micro_Cumul_Expected then
 368       Report.Failed ("Wrong cumulation result for type Micro");
 369    end if;
 370
 371
 372                ---=---=---=---=---=---=---=---=---=---=---
 373
 374
 375    Money_Actual := Data.Test_Money_Ops (0.0,
 376                                         Data.Money_Optr_Table_Cancel,
 377                                         Data.Money_Opnd_Table_Cancel);
 378
 379    if Money_Actual /= Money_Cancel_Expected then
 380       Report.Failed ("Wrong cancellation result for type Money");
 381    end if;
 382
 383                        ---=---=---=---=---=---=---
 384
 385
 386    Money_Actual := Data.Test_Money_Ops (0.0,
 387                                         Data.Money_Optr_Table_Cumul,
 388                                         Data.Money_Opnd_Table_Cumul);
 389
 390    if Money_Actual /= Money_Cumul_Expected then
 391       Report.Failed ("Wrong cumulation result for type Money");
 392    end if;
 393
 394
 395                ---=---=---=---=---=---=---=---=---=---=---
 396
 397
 398    Cash_Actual := Data.Test_Cash_Ops (0.0,
 399                                       Data.Cash_Optr_Table_Cancel,
 400                                       Data.Cash_Opnd_Table_Cancel);
 401
 402    if Cash_Actual /= Cash_Cancel_Expected then
 403       Report.Failed ("Wrong cancellation result for type Cash");
 404    end if;
 405
 406
 407                        ---=---=---=---=---=---=---
 408
 409
 410    Cash_Actual := Data.Test_Cash_Ops (0.0,
 411                                       Data.Cash_Optr_Table_Cumul,
 412                                       Data.Cash_Opnd_Table_Cumul);
 413
 414    if Cash_Actual /= Cash_Cumul_Expected then
 415       Report.Failed ("Wrong cumulation result for type Cash");
 416    end if;
 417
 418
 419                ---=---=---=---=---=---=---=---=---=---=---
 420
 421
 422    Broad_Actual := Data.Test_Broad_Ops (0.0,
 423                                         Data.Broad_Optr_Table_Cancel,
 424                                         Data.Broad_Opnd_Table_Cancel);
 425
 426    if Broad_Actual /= Broad_Cancel_Expected then
 427       Report.Failed ("Wrong cancellation result for type Broad");
 428    end if;
 429
 430
 431                        ---=---=---=---=---=---=---
 432
 433
 434    Broad_Actual := Data.Test_Broad_Ops (0.0,
 435                                         Data.Broad_Optr_Table_Cumul,
 436                                         Data.Broad_Opnd_Table_Cumul);
 437
 438    if Broad_Actual /= Broad_Cumul_Expected then
 439       Report.Failed ("Wrong cumulation result for type Broad");
 440    end if;
 441
 442
 443                ---=---=---=---=---=---=---=---=---=---=---
 444
 445
 446    Report.Result;
 447
 448 end CXF2A01;