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

   1 -- CXG2023.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 multiplication and division of decimal fixed point
  28 --      numbers produce exact results.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      Check that multiplication and division of decimal fixed point
  32 --      numbers produce exact results.
  33 --
  34 -- SPECIAL REQUIREMENTS
  35 --      The Strict Mode for the numerical accuracy must be
  36 --      selected.  The method by which this mode is selected
  37 --      is implementation dependent.
  38 --
  39 -- APPLICABILITY CRITERIA:
  40 --      This test applies only to implementations supporting the
  41 --      Numerics Annex.
  42 --      This test only applies to the Strict Mode for numerical
  43 --      accuracy.
  44 --      This test applies only to implementations supporting
  45 --      decimal fixed point types of at least 9 digits.
  46 --
  47 --
  48 -- CHANGE HISTORY:
  49 --       3 Apr 96   SAIC    Initial release for 2.1
  50 --
  51 --!
  52
  53 with System;
  54 with Report;
  55 procedure CXG2023 is
  56    Verbose : constant Boolean := False;
  57
  58 procedure Check_1 is
  59    Num_Digits : constant := 6;
  60    type Pennies is delta 0.01 digits Num_Digits;
  61    type Franklins is delta 100.0 digits Num_Digits;
  62    type Dollars is delta 1.0 digits Num_Digits;
  63
  64    P1 : Pennies;
  65    F1 : Franklins;
  66    D1 : Dollars;
  67
  68    -- optimization thwarting functions
  69
  70    function P (X : Pennies) return Pennies is
  71    begin
  72       if Report.Ident_Bool (True) then
  73           return X;
  74       else
  75           return 3.21;    -- never executed
  76       end if;
  77    end P;
  78
  79
  80    function F (X : Franklins) return Franklins is
  81    begin
  82       if Report.Ident_Bool (True) then
  83           return X;
  84       else
  85           return 32100.0;    -- never executed
  86       end if;
  87    end F;
  88
  89
  90    function D (X : Dollars) return Dollars is
  91    begin
  92       if Report.Ident_Bool (True) then
  93           return X;
  94       else
  95           return 321.0;    -- never executed
  96       end if;
  97    end D;
  98
  99
 100 begin
 101    -- multiplication where one operand is universal real
 102
 103    P1 := P(0.05) * 200.0;
 104    if P1 /= 10.00 then
 105       Report.Failed ("1 - expected 10.00  got " & Pennies'Image (P1));
 106    end if;
 107
 108    D1 := P(0.05) * 100.0;
 109    if D1 /= 5.00 then
 110       Report.Failed ("2 - expected 5.00  got " & Dollars'Image (D1));
 111    end if;
 112
 113    F1 := P(0.05) * 50_000.0;
 114    if F1 /= 2500.00 then
 115       Report.Failed ("3 - expected 2500.0  got " & Franklins'Image (F1));
 116    end if;
 117
 118    -- multiplication where both operands are decimal fixed
 119
 120    P1 := P(0.05) * D(-200.0);
 121    if P1 /= -10.00 then
 122       Report.Failed ("4 - expected -10.00  got " & Pennies'Image (P1));
 123    end if;
 124
 125    D1 := P(0.05) * P(-100.0);
 126    if D1 /= -5.00 then
 127       Report.Failed ("5 - expected -5.00  got " & Dollars'Image (D1));
 128    end if;
 129
 130    F1 := P(-0.05) * F(50_000.0);
 131    if F1 /= -2500.00 then
 132       Report.Failed ("6 - expected -2500.0  got " & Franklins'Image (F1));
 133    end if;
 134
 135    -- division where one operand is universal real
 136
 137    P1 := P(0.05) / 0.001;
 138    if P1 /= 50.00 then
 139       Report.Failed ("7 - expected 50.00  got " & Pennies'Image (P1));
 140    end if;
 141
 142    D1 := D(1000.0) / 3.0;
 143    if D1 /= 333.00 then
 144       Report.Failed ("8 - expected 333.00  got " & Dollars'Image (D1));
 145    end if;
 146
 147    F1 := P(1234.56) / 0.0001;
 148    if F1 /= 12345600.00 then
 149       Report.Failed ("9 - expected 12345600.0  got " & Franklins'Image (F1));
 150    end if;
 151
 152
 153    -- division where both operands are decimal fixed
 154
 155    P1 := P(0.05) / D(1.0);
 156    if P1 /= 0.05 then
 157       Report.Failed ("10 - expected 0.05  got " & Pennies'Image (P1));
 158    end if;
 159
 160        -- check for truncation toward 0
 161    D1 := P(-101.00) / P(2.0);
 162    if D1 /= -50.00 then
 163       Report.Failed ("11 - expected -50.00  got " & Dollars'Image (D1));
 164    end if;
 165
 166    P1 := P(-102.03) / P(-0.5);
 167    if P1 /= 204.06 then
 168       Report.Failed ("12 - expected 204.06  got " & Pennies'Image (P1));
 169    end if;
 170
 171    F1 := P(876.54) / P(0.03);
 172    if F1 /= 29200.00 then
 173       Report.Failed ("13 - expected 29200.0  got " & Franklins'Image (F1));
 174    end if;
 175
 176 exception
 177    when others =>
 178       Report.Failed ("unexpected exception in Check_1");
 179 end Check_1;
 180
 181 generic
 182    type Pennies   is delta<> digits<>;
 183    type Dollars   is delta<> digits<>;
 184    type Franklins is delta<> digits<>;
 185 procedure Generic_Check;
 186 procedure Generic_Check is
 187
 188    -- the following code is copied directly from the
 189    -- above procedure Check_1
 190
 191    P1 : Pennies;
 192    F1 : Franklins;
 193    D1 : Dollars;
 194
 195    -- optimization thwarting functions
 196
 197    function P (X : Pennies) return Pennies is
 198    begin
 199       if Report.Ident_Bool (True) then
 200           return X;
 201       else
 202           return 3.21;    -- never executed
 203       end if;
 204    end P;
 205
 206
 207    function F (X : Franklins) return Franklins is
 208    begin
 209       if Report.Ident_Bool (True) then
 210           return X;
 211       else
 212           return 32100.0;    -- never executed
 213       end if;
 214    end F;
 215
 216
 217    function D (X : Dollars) return Dollars is
 218    begin
 219       if Report.Ident_Bool (True) then
 220           return X;
 221       else
 222           return 321.0;    -- never executed
 223       end if;
 224    end D;
 225
 226
 227 begin
 228    -- multiplication where one operand is universal real
 229
 230    P1 := P(0.05) * 200.0;
 231    if P1 /= 10.00 then
 232       Report.Failed ("1 - expected 10.00  got " & Pennies'Image (P1));
 233    end if;
 234
 235    D1 := P(0.05) * 100.0;
 236    if D1 /= 5.00 then
 237       Report.Failed ("2 - expected 5.00  got " & Dollars'Image (D1));
 238    end if;
 239
 240    F1 := P(0.05) * 50_000.0;
 241    if F1 /= 2500.00 then
 242       Report.Failed ("3 - expected 2500.0  got " & Franklins'Image (F1));
 243    end if;
 244
 245    -- multiplication where both operands are decimal fixed
 246
 247    P1 := P(0.05) * D(-200.0);
 248    if P1 /= -10.00 then
 249       Report.Failed ("4 - expected -10.00  got " & Pennies'Image (P1));
 250    end if;
 251
 252    D1 := P(0.05) * P(-100.0);
 253    if D1 /= -5.00 then
 254       Report.Failed ("5 - expected -5.00  got " & Dollars'Image (D1));
 255    end if;
 256
 257    F1 := P(-0.05) * F(50_000.0);
 258    if F1 /= -2500.00 then
 259       Report.Failed ("6 - expected -2500.0  got " & Franklins'Image (F1));
 260    end if;
 261
 262    -- division where one operand is universal real
 263
 264    P1 := P(0.05) / 0.001;
 265    if P1 /= 50.00 then
 266       Report.Failed ("7 - expected 50.00  got " & Pennies'Image (P1));
 267    end if;
 268
 269    D1 := D(1000.0) / 3.0;
 270    if D1 /= 333.00 then
 271       Report.Failed ("8 - expected 333.00  got " & Dollars'Image (D1));
 272    end if;
 273
 274    F1 := P(1234.56) / 0.0001;
 275    if F1 /= 12345600.00 then
 276       Report.Failed ("9 - expected 12345600.0  got " & Franklins'Image (F1));
 277    end if;
 278
 279
 280    -- division where both operands are decimal fixed
 281
 282    P1 := P(0.05) / D(1.0);
 283    if P1 /= 0.05 then
 284       Report.Failed ("10 - expected 0.05  got " & Pennies'Image (P1));
 285    end if;
 286
 287        -- check for truncation toward 0
 288    D1 := P(-101.00) / P(2.0);
 289    if D1 /= -50.00 then
 290       Report.Failed ("11 - expected -50.00  got " & Dollars'Image (D1));
 291    end if;
 292
 293    P1 := P(-102.03) / P(-0.5);
 294    if P1 /= 204.06 then
 295       Report.Failed ("12 - expected 204.06  got " & Pennies'Image (P1));
 296    end if;
 297
 298    F1 := P(876.54) / P(0.03);
 299    if F1 /= 29200.00 then
 300       Report.Failed ("13 - expected 29200.0  got " & Franklins'Image (F1));
 301    end if;
 302
 303 end Generic_Check;
 304
 305
 306 procedure Check_G6 is
 307    Num_Digits : constant := 6;
 308    type Pennies is delta 0.01 digits Num_Digits;
 309    type Franklins is delta 100.0 digits Num_Digits;
 310    type Dollars is delta 1.0 digits Num_Digits;
 311
 312    procedure G is new Generic_Check (Pennies, Dollars, Franklins);
 313 begin
 314    G;
 315 end Check_G6;
 316
 317
 318 procedure Check_G9 is
 319    Num_Digits : constant := 9;
 320    type Pennies is delta 0.01 digits Num_Digits;
 321    type Franklins is delta 100.0 digits Num_Digits;
 322    type Dollars is delta 1.0 digits Num_Digits;
 323
 324    procedure G is new Generic_Check (Pennies, Dollars, Franklins);
 325 begin
 326    G;
 327 end Check_G9;
 328
 329
 330 begin  -- main
 331    Report.Test ("CXG2023",
 332                 "Check the accuracy of multiplication and division" &
 333                 " of decimal fixed point numbers");
 334
 335    if Verbose then
 336       Report.Comment ("starting Check_1");
 337    end if;
 338    Check_1;
 339
 340    if Verbose then
 341       Report.Comment ("starting Check_G6");
 342    end if;
 343    Check_G6;
 344
 345    if Verbose then
 346       Report.Comment ("starting Check_G9");
 347    end if;
 348    Check_G9;
 349
 350    Report.Result;
 351 end CXG2023;