view gcc/testsuite/ada/acats/tests/cxb/cxb4004.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line source

-- CXB4004.A
--
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
--      Check that function Length, with Display_Format parameter, will 
--      return the minimal length of a Numeric value that will be required 
--      to hold the largest value of type Num represented as Format. 
--
--      Check that function To_Decimal will produce a decimal type Num 
--      result that corresponds to parameter Item as represented by 
--      parameter Format.
--
--      Check that function To_Decimal propagates Conversion_Error when 
--      the value represented by parameter Item is outside the range of 
--      the Decimal_Type Num used to instantiate the package 
--      Decimal_Conversions 
--
--      Check that function To_Display returns a Numeric type result that 
--      represents Item under the specific Display_Format.
--
--      Check that function To_Display propagates Conversion_Error when 
--      parameter Item is negative and the specified Display_Format 
--      parameter is Unsigned.
--
-- TEST DESCRIPTION:
--      This test checks the results from instantiated versions of three
--      functions within generic package Interfaces.COBOL.Decimal_Conversions.
--      This generic package is instantiated twice, with decimal types having
--      four and ten digits representation. 
--      The function Length is validated with the Unsigned, Leading_Separate,
--      and Trailing_Separate Display_Format specifiers.
--      The results of function To_Decimal are verified in cases where it
--      is given a variety of Numeric and Display_Format type parameters.
--      Function To_Decimal is also checked to propagate Conversion_Error
--      when the value represented by parameter Item is outside the range 
--      of the type used to instantiate the package.
--      The results of function To_Display are verified in cases where it
--      is given a variety of Num and Display_Format parameters.  It is also
--      checked to ensure that it propagates Conversion_Error if parameter
--      Num is negative and the Format parameter is Unsigned.
--      
--      This test assumes that the following characters are all included
--      in the implementation defined type Interfaces.COBOL.COBOL_Character:
--      ' ', '0'..'9', '+', '-', and '.'.
--      
-- APPLICABILITY CRITERIA: 
--      This test is applicable to all implementations that provide 
--      package Interfaces.COBOL.  If an implementation provides
--      package Interfaces.COBOL, this test must compile, execute, and 
--      report "PASSED".
--
--       
-- CHANGE HISTORY:
--      06 Feb 96   SAIC    Initial release for 2.1.
--      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
--      27 Oct 96   SAIC    Incorporated reviewer comments.
--
--!

with Report;
with Interfaces.COBOL;                                          -- N/A => ERROR
with Ada.Exceptions;

procedure CXB4004 is
begin

   Report.Test ("CXB4004", "Check that the functions Length, To_Decimal, " &
                           "and To_Display produce correct results");

   Test_Block:
   declare

      use Interfaces;
      use Ada.Exceptions;
      use type Interfaces.COBOL.Numeric;

      Number_Of_Unsigned_Items          : constant := 6;
      Number_Of_Leading_Separate_Items  : constant := 6;
      Number_Of_Trailing_Separate_Items : constant := 6;
      Number_Of_Decimal_Items           : constant := 9;

      type Decimal_Type_1     is delta 0.01 digits  4;
      type Decimal_Type_2     is delta 1.0 digits  10;
      type Numeric_Access     is access COBOL.Numeric;
      type Numeric_Items_Type is array(Integer range <>) of Numeric_Access;

      Correct_Result : Boolean        := False;
      TC_Num_1       : Decimal_Type_1 := 0.0;
      TC_Num_2       : Decimal_Type_2 := 0.0;

      package Package_1 is new COBOL.Decimal_Conversions(Decimal_Type_1);
      package Package_2 is new COBOL.Decimal_Conversions(Decimal_Type_2);


      Package_1_Numeric_Items :
        Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
          (new COBOL.Numeric'("0"),
           new COBOL.Numeric'("591"),
           new COBOL.Numeric'("6342"),
           new COBOL.Numeric'("+0"),
           new COBOL.Numeric'("-1539"),
           new COBOL.Numeric'("+9199"),
           new COBOL.Numeric'("0-"),
           new COBOL.Numeric'("8934+"),
           new COBOL.Numeric'("9949-"));

      Package_2_Numeric_Items :
        Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
          (new COBOL.Numeric'("3"),
           new COBOL.Numeric'("105"),
           new COBOL.Numeric'("1234567899"),
           new COBOL.Numeric'("+8"),
           new COBOL.Numeric'("-12345601"),
           new COBOL.Numeric'("+9123459999"),
           new COBOL.Numeric'("1-"),
           new COBOL.Numeric'("123456781+"),
           new COBOL.Numeric'("9499999999-"));


      Decimal_Type_1_Items : array (1..Number_Of_Decimal_Items) 
                               of Decimal_Type_1 :=
        (0.0,  5.91,  63.42, 0.0, -15.39,  91.99, 0.0,  89.34, -99.49);

      Decimal_Type_2_Items : array (1..Number_Of_Decimal_Items) 
                               of Decimal_Type_2 :=
        ( 3.0,        105.0,  1234567899.0, 
          8.0,  -12345601.0,  9123459999.0,
         -1.0,  123456781.0, -9499999999.0);

   begin

      -- Check that function Length with Display_Format parameter will 
      -- return the minimal length of a Numeric value (number of 
      -- COBOL_Characters) that will be required to hold the largest 
      -- value of type Num. 

      if Package_1.Length(COBOL.Unsigned) /=  4 or
         Package_2.Length(COBOL.Unsigned) /= 10
      then
         Report.Failed("Incorrect results from function Length when " &
                       "used with Display_Format parameter Unsigned");
      end if;

      if Package_1.Length(Format => COBOL.Leading_Separate) /=  5 or
         Package_2.Length(Format => COBOL.Leading_Separate) /= 11
      then
         Report.Failed("Incorrect results from function Length when " &
                       "used with Display_Format parameter "          &
                       "Leading_Separate");
      end if;

      if Package_1.Length(COBOL.Trailing_Separate) /=  5 or
         Package_2.Length(COBOL.Trailing_Separate) /= 11
      then
         Report.Failed("Incorrect results from function Length when " &
                       "used with Display_Format parameter "          &
                       "Trailing_Separate");
      end if;


      -- Check that function To_Decimal with Numeric and Display_Format 
      -- parameters will produce a decimal type Num result that corresponds 
      -- to parameter Item as represented by parameter Format.

      for i in 1..Number_Of_Decimal_Items loop
         case i is
            when 1..3 =>  -- Unsigned Display_Format parameter.

               if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
                                       Format => COBOL.Unsigned) /=
                  Decimal_Type_1_Items(i)
               then
                  Report.Failed
                    ("Incorrect result from function To_Decimal "    &
                     "from an instantiation of Decimal_Conversions " &
                     "using a four-digit Decimal type, with Format " &
                     "parameter Unsigned, subtest index: "           &
                     Integer'Image(i)); 
               end if;

               if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
                                       Format => COBOL.Unsigned) /=
                  Decimal_Type_2_Items(i)
               then
                  Report.Failed
                    ("Incorrect result from function To_Decimal "    &
                     "from an instantiation of Decimal_Conversions " &
                     "using a ten-digit Decimal type, with Format "  &
                     "parameter Unsigned, subtest index: "           &
                     Integer'Image(i)); 
               end if;

            when 4..6 =>  -- Leading_Separate Display_Format parameter.

               if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
                                       Format => COBOL.Leading_Separate) /=
                  Decimal_Type_1_Items(i)
               then
                  Report.Failed
                    ("Incorrect result from function To_Decimal "    &
                     "from an instantiation of Decimal_Conversions " &
                     "using a four-digit Decimal type, with Format " &
                     "parameter Leading_Separate, subtest index: "   &
                     Integer'Image(i)); 
               end if;

               if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
                                       Format => COBOL.Leading_Separate) /=
                  Decimal_Type_2_Items(i)
               then
                  Report.Failed
                    ("Incorrect result from function To_Decimal "    &
                     "from an instantiation of Decimal_Conversions " &
                     "using a ten-digit Decimal type, with Format "  &
                     "parameter Leading_Separate, subtest index: "   &
                     Integer'Image(i)); 
               end if;

            when 7..9 =>  -- Trailing_Separate Display_Format parameter.

               if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
                                       COBOL.Trailing_Separate) /=
                  Decimal_Type_1_Items(i)
               then
                  Report.Failed
                    ("Incorrect result from function To_Decimal "    &
                     "from an instantiation of Decimal_Conversions " &
                     "using a four-digit Decimal type, with Format " &
                     "parameter Trailing_Separate, subtest index: "  &
                     Integer'Image(i)); 
               end if;

               if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
                                       COBOL.Trailing_Separate) /=
                  Decimal_Type_2_Items(i)
               then
                  Report.Failed
                    ("Incorrect result from function To_Decimal "    &
                     "from an instantiation of Decimal_Conversions " &
                     "using a ten-digit Decimal type, with Format "  &
                     "parameter Trailing_Separate, subtest index: "  &
                     Integer'Image(i)); 
               end if;

         end case;
      end loop;


      -- Check that function To_Decimal propagates Conversion_Error when 
      -- the value represented by Numeric type parameter Item is outside 
      -- the range of the Decimal_Type Num used to instantiate the package 
      -- Decimal_Conversions.

      declare
         TC_Numeric_1 : Decimal_Type_1 := Decimal_Type_1_Items(1);
      begin
         -- The COBOL.Numeric type used as parameter Item represents a
         -- Decimal value that is outside the range of the Decimal type 
         -- used to instantiate Package_1.
         TC_Numeric_1 := 
           Package_1.To_Decimal(Item   => Package_2_Numeric_Items(8).all,
                                Format => COBOL.Trailing_Separate);
         Report.Failed("Conversion_Error not raised by To_Decimal "     &
                       "when the value represented by parameter "       &
                       "Item is outside the range of the Decimal_Type " &
                       "used to instantiate the package "               &
                       "Decimal_Conversions");
         if TC_Numeric_1 = Decimal_Type_1_Items(1) then
            Report.Comment("To Guard Against Dead Assignment Elimination " &
                           "-- Should never be printed");
         end if;
      exception
         when COBOL.Conversion_Error => null;  -- OK, expected exception.
         when others =>
            Report.Failed("Incorrect exception raised by To_Decimal "      &
                          "when the value represented by parameter "       &
                          "Item is outside the range of the Decimal_Type " &
                          "used to instantiate the package "               &
                          "Decimal_Conversions");
      end;


      -- Check that function To_Display with decimal type Num and 
      -- Display_Format parameters returns a Numeric type result that 
      -- represents Item under the specific Display_Format.

      -- Unsigned Display_Format parameter.
      TC_Num_1       := 13.04;
      Correct_Result := (Package_1.To_Display(TC_Num_1, COBOL.Unsigned) =
                         "1304") AND
                        (Package_1.To_Display(TC_Num_1, COBOL.Unsigned) /= 
                         "13.04");
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Unsigned Display_Format parameter - 1");
      end if;

      TC_Num_2       := 1234567890.0;
      Correct_Result := Package_2.To_Display(TC_Num_2, 
                                             COBOL.Unsigned) = "1234567890";
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Unsigned Display_Format parameter - 2");
      end if;

      -- Leading_Separate Display_Format parameter.
      TC_Num_1       := -34.29;
      Correct_Result := (Package_1.To_Display(TC_Num_1, 
                                              COBOL.Leading_Separate) = 
                         "-3429") AND
                        (Package_1.To_Display(TC_Num_1,
                                              COBOL.Leading_Separate) /=
                         "-34.29");
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Leading_Separate Display_Format parameter - 1");
      end if;

      TC_Num_1       := 19.01;
      Correct_Result := Package_1.To_Display(TC_Num_1, 
                                             COBOL.Leading_Separate) = 
                        "+1901";
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Leading_Separate Display_Format parameter - 2");
      end if;

      TC_Num_2       := 1234567890.0;
      Correct_Result := Package_2.To_Display(TC_Num_2, 
                                             COBOL.Leading_Separate) = 
                        "+1234567890";
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Leading_Separate Display_Format parameter - 3");
      end if;

      TC_Num_2       := -1234567890.0;
      Correct_Result := Package_2.To_Display(TC_Num_2, 
                                             COBOL.Leading_Separate) = 
                        "-1234567890";
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Leading_Separate Display_Format parameter - 4");
      end if;

      -- Trailing_Separate Display_Format parameter.
      TC_Num_1       := -99.91;
      Correct_Result := (Package_1.To_Display(TC_Num_1, 
                                             COBOL.Trailing_Separate) = 
                         "9991-") AND
                        (Package_1.To_Display(TC_Num_1,
                                              COBOL.Trailing_Separate) /=
                         "99.91-");
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Trailing_Separate Display_Format parameter - 1");
      end if;

      TC_Num_1       := 51.99;
      Correct_Result := Package_1.To_Display(TC_Num_1, 
                                             COBOL.Trailing_Separate) = 
                        "5199+";
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Trailing_Separate Display_Format parameter - 2");
      end if;

      TC_Num_2       := 1234567890.0;
      Correct_Result := Package_2.To_Display(TC_Num_2, 
                                             COBOL.Trailing_Separate) = 
                        "1234567890+";
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Trailing_Separate Display_Format parameter - 3");
      end if;

      TC_Num_2       := -1234567890.0;
      Correct_Result := Package_2.To_Display(TC_Num_2, 
                                             COBOL.Trailing_Separate) = 
                        "1234567890-";
      if not Correct_Result then
         Report.Failed("Incorrect result from function To_Display with " &
                       "Trailing_Separate Display_Format parameter - 4");
      end if;


      -- Check that function To_Display propagates Conversion_Error when
      -- parameter Item is negative and the specified Display_Format 
      -- parameter is Unsigned.

      begin
         if Package_2.To_Display(Item   => Decimal_Type_2_Items(9),
                                 Format => COBOL.Unsigned) = 
            Package_2_Numeric_Items(2).all 
         then
            Report.Comment("To Guard Against Dead Assignment Elimination " &
                           "-- Should never be printed");
         end if;
         Report.Failed("Conversion_Error not raised by To_Display " &
                       "when the value represented by parameter "   &
                       "Item is negative and the Display_Format "   &
                       "parameter is Unsigned");
      exception
         when COBOL.Conversion_Error => null;  -- OK, expected exception.
         when others =>
            Report.Failed("Incorrect exception raised by To_Display " &
                          "when the value represented by parameter "  &
                          "Item is negative and the Display_Format "  &
                          "parameter is Unsigned");
      end;


   exception
      when The_Error : others => 
         Report.Failed ("The following exception was raised in the " &
                        "Test_Block: " & Exception_Name(The_Error));
   end Test_Block;

   Report.Result;

end CXB4004;