gcc/testsuite/ada/acats/tests/cxb/cxb4008.a

   1 -- CXB4008.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 function To_Decimal with Binary parameter will return
  28 --      the corresponding value of the decimal type Num.
  29 --
  30 --      Check that the function To_Decimal with Long_Binary parameter will
  31 --      return the corresponding value of the decimal type Num.
  32 --
  33 --      Check that both of the To_Decimal functions described above will
  34 --      propagate Conversion_Error if the converted value Item is outside
  35 --      the range of type Num.
  36 --
  37 --      Check that the function To_Binary converts a value of the Ada
  38 --      decimal type Num into a Binary type value.
  39 --
  40 --      Check that the function To_Long_Binary converts a value of the Ada
  41 --      decimal type Num into a Long_Binary type value.
  42 --
  43 -- TEST DESCRIPTION:
  44 --      This test uses several instantiations of generic package
  45 --      Decimal_Conversions to provide appropriate test material.
  46 --      Two of the instantiations use decimal types as generic actuals
  47 --      that include the implementation defined constants Max_Digits_Binary
  48 --      and Max_Digits_Long_Binary in their definition.
  49 --
  50 --      Subtests are included for both versions of function To_Decimal,
  51 --      (Binary and Long_Binary parameters), and include checks that
  52 --      Conversion_Error is propagated under the appropriate circumstances.
  53 --      Functions To_Binary and To_Long_Binary are "sanity" checked, to
  54 --      ensure that the functions are available, and that the results are
  55 --      appropriate based on their parameter input.
  56 --
  57 -- APPLICABILITY CRITERIA:
  58 --      This test is applicable to all implementations that provide
  59 --      package Interfaces.COBOL.  If an implementation provides
  60 --      package Interfaces.COBOL, this test must compile, execute, and
  61 --      report "PASSED".
  62 --
  63 --
  64 -- CHANGE HISTORY:
  65 --      21 Feb 96   SAIC    Initial release for 2.1.
  66 --      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
  67 --      27 Oct 96   SAIC    Incorporated reviewer comments.
  68 --
  69 --!
  70
  71 with Report;
  72 with Ada.Exceptions;
  73 with Interfaces.COBOL;                                          -- N/A => ERROR
  74
  75 procedure CXB4008 is
  76 begin
  77
  78    Report.Test ("CXB4008", "Check that functions To_Decimal, To_Binary, and " &
  79                            "To_Long_Binary produce the correct results");
  80
  81    Test_Block:
  82    declare
  83
  84       use Interfaces.COBOL;
  85       use Ada.Exceptions;
  86       use type Interfaces.COBOL.Numeric;
  87
  88       type Decimal_Type_1 is delta 0.1    digits  6;
  89       type Decimal_Type_2 is delta 0.01   digits Max_Digits_Binary;
  90       type Decimal_Type_3 is delta 0.001  digits 10;
  91       type Decimal_Type_4 is delta 0.0001 digits Max_Digits_Long_Binary;
  92
  93       package Pack_1 is new Decimal_Conversions(Decimal_Type_1);
  94       package Pack_2 is new Decimal_Conversions(Decimal_Type_2);
  95       package Pack_3 is new Decimal_Conversions(Decimal_Type_3);
  96       package Pack_4 is new Decimal_Conversions(Decimal_Type_4);
  97
  98       TC_Dec_1       : Decimal_Type_1 := 12345.0;
  99       TC_Dec_2       : Decimal_Type_2 := 123456.00;
 100       TC_Dec_3       : Decimal_Type_3 := 1234567.000;
 101       TC_Dec_4       : Decimal_Type_4 := 12345678.0000;
 102       TC_Binary      : Interfaces.COBOL.Binary;
 103       TC_Long_Binary : Interfaces.COBOL.Long_Binary;
 104
 105    begin
 106
 107       -- Check that the function To_Decimal with Binary parameter will
 108       -- return the corresponding value of the decimal type Num.
 109
 110       if Pack_1.To_Decimal(Item => Pack_1.To_Binary(TC_Dec_1)) /= TC_Dec_1 or
 111          Pack_2.To_Decimal(Pack_2.To_Binary(TC_Dec_2))         /= TC_Dec_2
 112       then
 113          Report.Failed("Incorrect result from function To_Decimal with " &
 114                        "Binary parameter - 1");
 115       end if;
 116
 117       if Pack_1.To_Decimal(Item => Pack_1.To_Binary(1234.0)) /= 1234.0 then
 118          Report.Failed("Incorrect result from function To_Decimal with " &
 119                        "Binary parameter - 2");
 120       end if;
 121
 122       TC_Binary := Pack_2.To_Binary(TC_Dec_2);
 123       if Pack_2.To_Decimal(TC_Binary) /= TC_Dec_2 then
 124          Report.Failed("Incorrect result from function To_Decimal with " &
 125                        "Binary parameter - 3");
 126       end if;
 127
 128
 129
 130       -- Check that the function To_Decimal with Long_Binary parameter
 131       -- will return the corresponding value of the decimal type Num.
 132
 133       if Pack_3.To_Decimal(Item => Pack_3.To_Long_Binary(TC_Dec_3)) /=
 134          TC_Dec_3                                                      or
 135          Pack_4.To_Decimal(Pack_4.To_Long_Binary(TC_Dec_4))         /=
 136          TC_Dec_4
 137       then
 138          Report.Failed("Incorrect result from function To_Decimal with " &
 139                        "Long_Binary parameter - 1");
 140       end if;
 141
 142       if Pack_3.To_Decimal(Pack_3.To_Long_Binary(1234567.0)) /= 1234567.0 then
 143          Report.Failed("Incorrect result from function To_Decimal with " &
 144                        "Long_Binary parameter - 2");
 145       end if;
 146
 147       TC_Long_Binary := Pack_4.To_Long_Binary(TC_Dec_4);
 148       if Pack_4.To_Decimal(TC_Long_Binary) /= TC_Dec_4 then
 149          Report.Failed("Incorrect result from function To_Decimal with " &
 150                        "Long_Binary parameter - 3");
 151       end if;
 152
 153
 154
 155       -- Check that both of the To_Decimal functions described above
 156       -- will propagate Conversion_Error if the converted value Item is
 157       -- outside the range of type Num.
 158       -- Note: Binary/Long_Binary parameter values are created by an
 159       --       instantiation of To_Binary/To_Long_Binary with a larger
 160       --       Num type as the generic formal.
 161
 162       Binary_Parameter:
 163       begin
 164          TC_Dec_1 := Pack_1.To_Decimal(Pack_2.To_Binary(123456.78));
 165          Report.Failed("Conversion_Error was not raised by function " &
 166                        "To_Decimal with Binary parameter, when the "  &
 167                        "converted value Item was outside the range "  &
 168                        "of type Num");
 169          if TC_Dec_1 = 12345.6 then  -- Avoid dead assignment optimization.
 170             Report.Comment("Should never be printed");
 171          end if;
 172       exception
 173          when Conversion_Error   => null;  -- OK, expected exception.
 174          when The_Error : others =>
 175             Report.Failed(Ada.Exceptions.Exception_Name(The_Error) & " "   &
 176                           "was incorrectly raised by function To_Decimal " &
 177                           "with Binary parameter, when the converted "     &
 178                           "value Item was outside the range of type Num");
 179       end Binary_Parameter;
 180
 181       Long_Binary_Parameter:
 182       begin
 183          TC_Dec_3 := Pack_3.To_Decimal(Pack_4.To_Long_Binary(TC_Dec_4));
 184          Report.Failed("Conversion_Error was not raised by function "     &
 185                        "To_Decimal with Long_Binary parameter, when "     &
 186                        "the converted value Item was outside the range "  &
 187                        "of type Num");
 188          if TC_Dec_3 = 123456.78 then  -- Avoid dead assignment optimization.
 189             Report.Comment("Should never be printed");
 190          end if;
 191       exception
 192          when Conversion_Error   => null;  -- OK, expected exception.
 193          when The_Error : others =>
 194             Report.Failed(Ada.Exceptions.Exception_Name(The_Error) & " "    &
 195                           "was incorrectly raised by function To_Decimal "  &
 196                           "with Long_Binary parameter, when the converted " &
 197                           "value Item was outside the range of type Num");
 198       end Long_Binary_Parameter;
 199
 200
 201
 202       -- Check that the function To_Binary converts a value of the Ada
 203       -- decimal type Num into a Binary type value.
 204
 205       TC_Dec_1 := 123.4;
 206       TC_Dec_2 := 9.99;
 207       if Pack_1.To_Binary(TC_Dec_1) = Pack_1.To_Binary(-TC_Dec_1) or
 208          Pack_2.To_Binary(TC_Dec_2) = Pack_2.To_Binary(-TC_Dec_2)
 209       then
 210          Report.Failed("Incorrect result from function To_Binary - 1");
 211       end if;
 212
 213       if Pack_1.To_Binary(1.1)     = Pack_1.To_Binary(-1.1)      or
 214          Pack_2.To_Binary(9999.99) = Pack_2.To_Binary(-9999.99)
 215       then
 216          Report.Failed("Incorrect result from function To_Binary - 2");
 217       end if;
 218
 219
 220       -- Check that the function To_Long_Binary converts a value of the
 221       -- Ada decimal type Num into a Long_Binary type value.
 222
 223       TC_Dec_3 := 9.001;
 224       TC_Dec_4 := 123.4567;
 225       if Pack_3.To_Long_Binary(TC_Dec_3) = Pack_3.To_Long_Binary(-TC_Dec_3) or
 226          Pack_4.To_Long_Binary(TC_Dec_4) = Pack_4.To_Long_Binary(-TC_Dec_4)
 227       then
 228          Report.Failed("Incorrect result from function To_Long_Binary - 1");
 229       end if;
 230
 231       if Pack_3.To_Long_Binary(1.011)        =
 232          Pack_3.To_Long_Binary(-1.011)         or
 233          Pack_4.To_Long_Binary(2345678.9012) =
 234          Pack_4.To_Long_Binary(-2345678.9012)
 235       then
 236          Report.Failed("Incorrect result from function To_Long_Binary - 2");
 237       end if;
 238
 239
 240    exception
 241       when The_Error : others =>
 242          Report.Failed("The following exception was raised in the " &
 243                        "Test_Block: " & Exception_Name(The_Error));
 244    end Test_Block;
 245
 246    Report.Result;
 247
 248 end CXB4008;