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

   1 -- CXG2024.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
  28 --      and binary fixed point numbers that result in a
  29 --      decimal fixed point type produce acceptable results.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      Multiplication and division of mixed binary and decimal
  33 --      values are performed.  Identity functions are used so
  34 --      that the operands of the expressions will not be seen
  35 --      as static by the compiler.
  36 --
  37 -- SPECIAL REQUIREMENTS
  38 --      The Strict Mode for the numerical accuracy must be
  39 --      selected.  The method by which this mode is selected
  40 --      is implementation dependent.
  41 --
  42 -- APPLICABILITY CRITERIA:
  43 --      This test applies only to implementations supporting the
  44 --      Numerics Annex.
  45 --      This test only applies to the Strict Mode for numerical
  46 --      accuracy.
  47 --      This test applies only to implementations supporting
  48 --      decimal fixed point types of at least 9 digits.
  49 --
  50 --
  51 -- CHANGE HISTORY:
  52 --       4 Apr 96   SAIC    Initial release for 2.1
  53 --      17 Aug 96   SAIC    Removed checks for close results
  54 --
  55 --!
  56
  57 with System;
  58 with Report;
  59 procedure CXG2024 is
  60
  61 procedure Do_Check is
  62    Num_Digits : constant := 9;
  63    type Pennies is delta 0.01 digits Num_Digits;
  64    type Dollars is delta 1.0 digits Num_Digits;
  65
  66    type Signed_Sixteenths is delta 0.0625
  67           range -2.0 ** (System.Max_Mantissa-5) ..
  68                  2.0 ** (System.Max_Mantissa-5) - 1.0;
  69    type Unsigned_Sixteenths is delta 0.0625
  70           range 0.0 .. 2.0 ** (System.Max_Mantissa-4) - 1.0;
  71
  72    P1 : Pennies;
  73    D1 : Dollars;
  74
  75    -- optimization thwarting functions
  76
  77    function P (X : Pennies) return Pennies is
  78    begin
  79       if Report.Ident_Bool (True) then
  80           return X;
  81       else
  82           return 3.21;    -- never executed
  83       end if;
  84    end P;
  85
  86
  87    function D (X : Dollars) return Dollars is
  88    begin
  89       if Report.Ident_Bool (True) then
  90           return X;
  91       else
  92           return 321.0;    -- never executed
  93       end if;
  94    end D;
  95
  96
  97    function US (X : Unsigned_Sixteenths) return Unsigned_Sixteenths is
  98    begin
  99       if Report.Ident_Bool (True) then
 100           return X;
 101       else
 102           return 321.0;    -- never executed
 103       end if;
 104    end US;
 105
 106
 107    function SS (X : Signed_Sixteenths) return Signed_Sixteenths is
 108    begin
 109       if Report.Ident_Bool (True) then
 110           return X;
 111       else
 112           return 321.0;    -- never executed
 113       end if;
 114    end SS;
 115
 116
 117 begin
 118
 119    P1 := P(0.05) * SS(-200.0);
 120    if P1 /= -10.00 then
 121          Report.Failed ("1 - expected -10.00  got " & Pennies'Image (P1));
 122    end if;
 123
 124    D1 := P(0.05) * SS(-100.0);
 125    if D1 /= -5.00 then
 126          Report.Failed ("2 - expected -5.00  got " & Dollars'Image (D1));
 127    end if;
 128
 129    P1 := P(0.05) * US(200.0);
 130    if P1 /= 10.00 then
 131          Report.Failed ("3 - expected 10.00  got " & Pennies'Image (P1));
 132    end if;
 133
 134    D1 := P(-0.05) * US(100.0);
 135    if D1 /= -5.00 then
 136          Report.Failed ("4 - expected -5.00  got " & Dollars'Image (D1));
 137    end if;
 138
 139
 140
 141    P1 := P(0.05) / US(1.0);
 142    if P1 /= 0.05 then
 143          Report.Failed ("6 - expected 0.05  got " & Pennies'Image (P1));
 144    end if;
 145
 146
 147    -- check rounding
 148
 149    D1 := Dollars'Round (Pennies (P(-101.00) / US(2.0)));
 150    if D1 /= -51.00 then
 151          Report.Failed ("11 - expected -51.00  got " & Dollars'Image (D1));
 152    end if;
 153
 154    D1 := Dollars'Round (Pennies (P(101.00) / US(2.0)));
 155    if D1 /= 51.00 then
 156          Report.Failed ("12 - expected 51.00  got " & Dollars'Image (D1));
 157    end if;
 158
 159    D1 := Dollars'Round (Pennies (SS(-101.00) / P(2.0)));
 160    if D1 /= -51.00 then
 161          Report.Failed ("13 - expected -51.00  got " & Dollars'Image (D1));
 162    end if;
 163
 164    D1 := Dollars'Round (Pennies (US(101.00) / P(2.0)));
 165    if D1 /= 51.00 then
 166          Report.Failed ("14 - expected 51.00  got " & Dollars'Image (D1));
 167    end if;
 168
 169
 170
 171    P1 := P(-102.03) / SS(-0.5);
 172    if P1 /= 204.06 then
 173          Report.Failed ("15 - expected 204.06  got " & Pennies'Image (P1));
 174    end if;
 175
 176
 177 exception
 178    when others =>
 179       Report.Failed ("unexpected exception in Do_Check");
 180 end Do_Check;
 181
 182
 183 begin  -- main
 184    Report.Test ("CXG2024",
 185                 "Check the accuracy of multiplication and division" &
 186                 " of mixed decimal and binary fixed point numbers");
 187
 188    Do_Check;
 189
 190    Report.Result;
 191 end CXG2024;