cxb4005.a

来自「linux下编程用 编译软件」· A 代码 · 共 333 行

-- CXB4005.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 the function To_COBOL will convert a String 
--      parameter value into a type Alphanumeric array of 
--      COBOL_Characters, with lower bound of one, and length 
--      equal to length of the String parameter, based on the 
--      mapping Ada_to_COBOL.
--
--      Check that the function To_Ada will convert a type 
--      Alphanumeric parameter value into a String type result, 
--      with lower bound of one, and length equal to the length 
--      of the Alphanumeric parameter, based on the mapping 
--      COBOL_to_Ada.
--
--      Check that the Ada_to_COBOL and COBOL_to_Ada mapping 
--      arrays provide a mapping capability between Ada's type 
--      Character and COBOL run-time character sets.
--
-- TEST DESCRIPTION:
--      This test checks that the functions To_COBOL and To_Ada produce
--      the correct results, based on a variety of parameter input values.
--      
--      In the first series of subtests, the results of the function
--      To_COBOL are compared against expected Alphanumeric type results,
--      and the length and lower bound of the alphanumeric result are
--      also verified.  In the second series of subtests, the results of
--      the function To_Ada are compared against expected String type
--      results, and the length of the String result is also verified 
--      against the Alphanumeric type parameter.
--      
--      This test also verifies that two mapping array variables defined 
--      in package Interfaces.COBOL, Ada_To_COBOL and COBOL_To_Ada, are 
--      available, and that they can be modified by a user at runtime.  
--      Finally, the effects of user modifications on these mapping 
--      variables is checked in the test.
--      
--      This test uses Fixed, Bounded, and Unbounded_Strings in combination
--      with the functions under validation.
--      
--      This test assumes that the following characters are all included
--      in the implementation defined type Interfaces.COBOL.COBOL_Character:
--      ' ', 'a'..'z', 'A'..'Z', '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:
--      11 Jan 96   SAIC    Initial prerelease version for ACVC 2.1
--      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
--      27 Oct 96   SAIC    Incorporated reviewer comments.
--
--!

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

procedure CXB4005 is
begin

   Report.Test ("CXB4005", "Check that the functions To_COBOL and " &
                           "To_Ada produce correct results");

   Test_Block:
   declare

      package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(5);
      package Unb renames Ada.Strings.Unbounded;

      use Ada.Exceptions;
      use Interfaces;
      use Bnd;
      use type Unb.Unbounded_String;
      use type Interfaces.COBOL.Alphanumeric;

      TC_Alphanumeric_1  : Interfaces.COBOL.Alphanumeric(1..1);
      TC_Alphanumeric_5  : Interfaces.COBOL.Alphanumeric(1..5);
      TC_Alphanumeric_10 : Interfaces.COBOL.Alphanumeric(1..10);
      TC_Alphanumeric_20 : Interfaces.COBOL.Alphanumeric(1..20);

      Bnd_String,
      TC_Bnd_String      : Bnd.Bounded_String   :=
                             Bnd.To_Bounded_String("     ");
      Unb_String,
      TC_Unb_String      : Unb.Unbounded_String :=
                             Unb.To_Unbounded_String("                    ");

      The_String,
      TC_String          : String(1..20) := ("                    ");

   begin

      -- Check that the function To_COBOL will convert a String 
      -- parameter value into a type Alphanumeric array of 
      -- COBOL_Characters, with lower bound of one, and length 
      -- equal to length of the String parameter, based on the 
      -- mapping Ada_to_COBOL.

      Unb_String         := Unb.To_Unbounded_String("A");
      TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));

      if TC_Alphanumeric_1        /= "A"                    or
         TC_Alphanumeric_1'Length /= Unb.Length(Unb_String) or
         TC_Alphanumeric_1'Length /= 1                      or
         COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
      then
         Report.Failed("Incorrect result from function To_COBOL - 1");
      end if;

      Bnd_String         := Bnd.To_Bounded_String("abcde");
      TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));

      if TC_Alphanumeric_5        /= "abcde"                or
         TC_Alphanumeric_5'Length /= Bnd.Length(Bnd_String) or
         TC_Alphanumeric_5'Length /= 5                      or
         COBOL.To_COBOL(Bnd.To_String(Bnd_String))'First  /= 1
      then
         Report.Failed("Incorrect result from function To_COBOL - 2");
      end if;

      Unb_String         := Unb.To_Unbounded_String("1A2B3c4d5F");
      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));

      if TC_Alphanumeric_10        /= "1A2B3c4d5F"           or
         TC_Alphanumeric_10'Length /= Unb.Length(Unb_String) or
         TC_Alphanumeric_10'Length /= 10                     or
         COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
      then
         Report.Failed("Incorrect result from function To_COBOL - 3");
      end if;

      The_String         := "abcd  ghij" & "1234  7890";
      TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);

      if TC_Alphanumeric_20                /= "abcd  ghij1234  7890" or
         TC_Alphanumeric_20'Length         /= The_String'Length      or
         TC_Alphanumeric_20'Length         /= 20                     or
         COBOL.To_COBOL(The_String)'First  /= 1
      then
         Report.Failed("Incorrect result from function To_COBOL - 4");
      end if;



      -- Check that the function To_Ada will convert a type 
      -- Alphanumeric parameter value into a String type result, 
      -- with lower bound of one, and length equal to the length 
      -- of the Alphanumeric parameter, based on the mapping 
      -- COBOL_to_Ada.

      TC_Unb_String := Unb.To_Unbounded_String 
                         (COBOL.To_Ada(TC_Alphanumeric_1));

      if TC_Unb_String             /= "A"                       or
         TC_Alphanumeric_1'Length  /= Unb.Length(TC_Unb_String) or
         Unb.Length(TC_Unb_String) /= 1                         or
         COBOL.To_Ada(TC_Alphanumeric_1)'First /= 1
      then
         Report.Failed("Incorrect value returned from function To_Ada - 1");
      end if;

      TC_Bnd_String := Bnd.To_Bounded_String 
                         (COBOL.To_Ada(TC_Alphanumeric_5));

      if TC_Bnd_String             /= "abcde"                   or
         TC_Alphanumeric_5'Length  /= Bnd.Length(TC_Bnd_String) or
         Bnd.Length(TC_Bnd_String) /= 5                         or
         COBOL.To_Ada(TC_Alphanumeric_5)'First /= 1
      then
         Report.Failed("Incorrect value returned from function To_Ada - 2");
      end if;

      TC_Unb_String := Unb.To_Unbounded_String 
                         (COBOL.To_Ada(TC_Alphanumeric_10));

      if TC_Unb_String             /= "1A2B3c4d5F"              or
         TC_Alphanumeric_10'Length /= Unb.Length(TC_Unb_String) or
         Unb.Length(TC_Unb_String) /= 10                        or
         COBOL.To_Ada(TC_Alphanumeric_10)'First /= 1
      then
         Report.Failed("Incorrect value returned from function To_Ada - 3");
      end if;

      TC_String := COBOL.To_Ada(TC_Alphanumeric_20);

      if TC_String                 /= "abcd  ghij1234  7890" or
         TC_Alphanumeric_20'Length /= TC_String'Length       or
         TC_String'Length          /= 20                     or
         COBOL.To_Ada(TC_Alphanumeric_20)'First /= 1
      then
         Report.Failed("Incorrect value returned from function To_Ada - 4");
      end if;


      -- Check the two functions when used in combination.

      if COBOL.To_COBOL(Item => COBOL.To_Ada("This is a test")) /=
         "This is a test"                                         or
         COBOL.To_COBOL(COBOL.To_Ada("1234567890abcdeFGHIJ"))   /=
         "1234567890abcdeFGHIJ"
      then
         Report.Failed("Incorrect result returned when using the " &
                       "functions To_Ada and To_COBOL in combination");
      end if;



      -- Check that the Ada_to_COBOL and COBOL_to_Ada mapping 
      -- arrays provide a mapping capability between Ada's type 
      -- Character and COBOL run-time character sets.

      Interfaces.COBOL.Ada_To_COBOL('a') := 'A';
      Interfaces.COBOL.Ada_To_COBOL('b') := 'B';
      Interfaces.COBOL.Ada_To_COBOL('c') := 'C';
      Interfaces.COBOL.Ada_To_COBOL('d') := '1';
      Interfaces.COBOL.Ada_To_COBOL('e') := '2';
      Interfaces.COBOL.Ada_To_COBOL('f') := '3';
      Interfaces.COBOL.Ada_To_COBOL(' ') := '*';

      Unb_String         := Unb.To_Unbounded_String("b");
      TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));

      if TC_Alphanumeric_1 /= "B" then
         Report.Failed("Incorrect result from function To_COBOL after " &
                       "modification to Ada_To_COBOL mapping array - 1");
      end if;

      Bnd_String         := Bnd.To_Bounded_String("abcde");
      TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));

      if TC_Alphanumeric_5 /= "ABC12" then
         Report.Failed("Incorrect result from function To_COBOL after " &
                       "modification to Ada_To_COBOL mapping array - 2");
      end if;

      Unb_String         := Unb.To_Unbounded_String("1a2B3c4d5e");
      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));

      if TC_Alphanumeric_10 /= "1A2B3C4152" then
         Report.Failed("Incorrect result from function To_COBOL after " &
                       "modification to Ada_To_COBOL mapping array - 3");
      end if;

      The_String         := "abcd  ghij" & "1234  7890";
      TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);

      if TC_Alphanumeric_20 /= "ABC1**ghij1234**7890" then
         Report.Failed("Incorrect result from function To_COBOL after " &
                       "modification to Ada_To_COBOL mapping array - 4");
      end if;


      -- Reset the Ada_To_COBOL mapping array to its original state.

      Interfaces.COBOL.Ada_To_COBOL('a') := 'a';
      Interfaces.COBOL.Ada_To_COBOL('b') := 'b';
      Interfaces.COBOL.Ada_To_COBOL('c') := 'c';
      Interfaces.COBOL.Ada_To_COBOL('d') := 'd';
      Interfaces.COBOL.Ada_To_COBOL('e') := 'e';
      Interfaces.COBOL.Ada_To_COBOL('f') := 'f';
      Interfaces.COBOL.Ada_To_COBOL(' ') := ' ';

      -- Modify the COBOL_To_Ada mapping array to check its effect on
      -- the function To_Ada.

      Interfaces.COBOL.COBOL_To_Ada(' ') := '*';
      Interfaces.COBOL.COBOL_To_Ada('$') := 'F';
      Interfaces.COBOL.COBOL_To_Ada('1') := '7';
      Interfaces.COBOL.COBOL_To_Ada('.') := ',';

      Unb_String         := Unb.To_Unbounded_String("  $$100.00");
      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
      TC_Unb_String      := Unb.To_Unbounded_String(
                              COBOL.To_Ada(TC_Alphanumeric_10));

      if Unb.To_String(TC_Unb_String) /= "**FF700,00" then
         Report.Failed("Incorrect result from function To_Ada after " &
                       "modification of COBOL_To_Ada mapping array - 1");
      end if;

      Interfaces.COBOL.COBOL_To_Ada('*') := ' ';
      Interfaces.COBOL.COBOL_To_Ada('F') := '$';
      Interfaces.COBOL.COBOL_To_Ada('7') := '1';
      Interfaces.COBOL.COBOL_To_Ada(',') := '.';

      if COBOL.To_Ada(COBOL.To_COBOL(Unb.To_String(TC_Unb_String))) /= 
         Unb_String 
      then
         Report.Failed("Incorrect result from function To_Ada after " &
                       "modification of COBOL_To_Ada mapping array - 2");
      end if;


   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 CXB4005;