cxa4005.a

来自「linux下编程用 编译软件」· A 代码 · 共 684 行 · 第 1/2 页

-- CXA4005.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 subprograms defined in package Ada.Strings.Fixed are
--      available, and that they produce correct results.  Specifically,
--      check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice,
--      Tail, Trim, and "*".
--
-- TEST DESCRIPTION:
--      This test, when combined with tests CXA4002-4 will provide coverage
--      of the functionality found in Ada.Strings.Fixed.
--      This test contains many small, specific test cases, situations that
--      although common in user environments, are often difficult to generate
--      in large numbers in a application-based test.  They represent
--      individual usage paradigms in-the-small.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      11 Apr 95   SAIC    Corrected acceptance conditions of certain
--                          subtests.
--	06 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1.
--      22 Feb 01   PHL     Check that the lower bound of the result is 1.
--      13 Mar 01   RLB     Fixed a couple of ACATS style violations;
--                          removed pointless checks of procedures.
--                          Added checks of other functions. These changes
--                          were made to test Defect Report 8652/0049, as
--                          reflected in Technical Corrigendum 1.
--
--!

with Report;
with Ada.Strings;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;

procedure CXA4005 is

    type TC_Name_Holder is access String;
    Name : TC_Name_Holder;

    function TC_Check (S : String) return String is
    begin
        if S'First /= 1 then
            Report.Failed ("Lower bound of result of function " & Name.all &
                           " is" & Integer'Image (S'First));
        end if;
        return S;
    end TC_Check;

    procedure TC_Set_Name (N : String) is
    begin
        Name := new String'(N);
    end TC_Set_Name;

begin

   Report.Test("CXA4005", "Check that the subprograms defined in "    &
                          "package Ada.Strings.Fixed are available, " &
                          "and that they produce correct results");

   Test_Block:
   declare

      package ASF  renames Ada.Strings.Fixed;
      package Maps renames Ada.Strings.Maps;

      Result_String,
      Delete_String,
      Insert_String,
      Trim_String,
      Overwrite_String  : String(1..10) := (others => Ada.Strings.Space);

      Source_String1    : String(1..5)  := "abcde";     -- odd length string
      Source_String2    : String(1..6)  := "abcdef";    -- even length string
      Source_String3    : String(1..12) := "abcdefghijkl";
      Source_String4    : String(1..12) := "abcdefghij  "; -- last two ch pad
      Source_String5    : String(1..12) := "  cdefghijkl"; -- first two ch pad
      Source_String6    : String(1..12) := "abcdefabcdef";

      Location     : Natural := 0;
      Slice_Start  : Positive;
      Slice_End,
      Slice_Count  : Natural := 0;

      CD_Set       : Maps.Character_Set := Maps.To_Set("cd");
      X_Set        : Maps.Character_Set := Maps.To_Set('x');
      ABCD_Set     : Maps.Character_Set := Maps.To_Set("abcd");
      A_to_F_Set   : Maps.Character_Set := Maps.To_Set("abcdef");

      CD_to_XY_Map : Maps.Character_Mapping :=
                                 Maps.To_Mapping(From => "cd",  To => "xy");

   begin

      -- Procedure Replace_Slice
      -- The functionality of this procedure
      -- is similar to procedure Move, and
      -- is tested here in the same manner, evaluated
      -- with various combinations of parameters.

      -- Index_Error propagation when Low > Source'Last + 1

      begin
         ASF.Replace_Slice(Result_String,
                           Result_String'Last + 2, -- should raise exception
                           Result_String'Last,
                           "xxxxxxx");
         Report.Failed("Index_Error not raised by Replace_Slice - 1");
      exception
         when Ada.Strings.Index_Error => null; -- OK, expected exception.
         when others                  =>
            Report.Failed("Incorrect exception from Replace_Slice - 1");
      end;

      -- Index_Error propagation when High < Source'First - 1

      begin
         ASF.Replace_Slice(Result_String(5..10),
                           5,
                           3, -- should raise exception since < 'First - 1.
                           "xxxxxxx");
         Report.Failed("Index_Error not raised by Replace_Slice - 2");
      exception
         when Ada.Strings.Index_Error => null; -- OK, expected exception.
         when others                  =>
            Report.Failed("Incorrect exception from Replace_Slice - 2");
      end;

      -- Justify = Left (default case)

      Result_String := "XXXXXXXXXX";

      ASF.Replace_Slice(Source => Result_String,
                        Low    =>  1,
                        High   => 10,
                        By     => Source_String1);   -- "abcde"

      if Result_String /= "abcde     " then
         Report.Failed("Incorrect result from Replace_Slice - Justify = Left");
      end if;

      -- Justify = Right

      ASF.Replace_Slice(Source  => Result_String,
                        Low     => 1,
                        High    => Result_String'Last,
                        By      => Source_String2,      -- "abcdef"
                        Drop    => Ada.Strings.Error,
                        Justify => Ada.Strings.Right);

      if Result_String /= "    abcdef" then
         Report.Failed("Incorrect result from Replace_Slice - Justify=Right");
      end if;

      -- Justify = Center (two cases, odd and even pad lengths)

      ASF.Replace_Slice(Result_String,
                        1,
                        Result_String'Last,
                        Source_String1,      -- "abcde"
                        Ada.Strings.Error,
                        Ada.Strings.Center,
                        'x');                -- non-default padding.

      if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
         Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1");
      end if;

      ASF.Replace_Slice(Result_String,
                        1,
                        Result_String'Last,
                        Source_String2,        -- "abcdef"
                        Ada.Strings.Error,
                        Ada.Strings.Center);

      if Result_String /= "  abcdef  " then    -- Equal padding added on L/R.
         Report.Failed("Incorrect result from Replace_Slice with " &
                       "Justify = Center - 2");
      end if;

      -- When the source string is longer than the target string, several
      -- cases can be examined, with the results depending on the value of
      -- the Drop parameter.

      -- Drop = Left

      ASF.Replace_Slice(Result_String,
                        1,
                        Result_String'Last,
                        Source_String3,            -- "abcdefghijkl"
                        Drop => Ada.Strings.Left);

      if Result_String /= "cdefghijkl" then
         Report.Failed("Incorrect result from Replace_Slice - Drop=Left");
      end if;

      -- Drop = Right

      ASF.Replace_Slice(Result_String,
                        1,
                        Result_String'Last,
                        Source_String3,        -- "abcdefghijkl"
                        Ada.Strings.Right);

      if Result_String /= "abcdefghij" then
         Report.Failed("Incorrect result, Replace_Slice with Drop=Right");
      end if;

      -- Drop = Error

      -- The effect in this case depends on the value of the justify
      -- parameter, and on whether any characters in Source other than
      -- Pad would fail to be copied.

      -- Drop = Error, Justify = Left, right overflow characters are pad.

      ASF.Replace_Slice(Result_String,
                        1,
                        Result_String'Last,
                        Source_String4,               -- "abcdefghij  "
                        Drop    => Ada.Strings.Error,
                        Justify => Ada.Strings.Left);

      if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
          Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1");
      end if;

      -- Drop = Error, Justify = Right, left overflow characters are pad.

      ASF.Replace_Slice(Source   => Result_String,
                        Low      => 1,
                        High     => Result_String'Last,
                        By       => Source_String5,     -- "  cdefghijkl"
                        Drop     => Ada.Strings.Error,
                        Justify  => Ada.Strings.Right);

      if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
         Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2");
      end if;

      -- In other cases of Drop=Error, Length_Error is propagated, such as:

      begin

         ASF.Replace_Slice(Source   => Result_String,
                           Low      => 1,
                           High     => Result_String'Last,
                           By       => Source_String3,    -- "abcdefghijkl"
                           Drop     => Ada.Strings.Error);

          Report.Failed("Length_Error not raised by Replace_Slice - 1");

      exception
         when Ada.Strings.Length_Error => null;   -- OK
         when others =>
            Report.Failed("Incorrect exception from Replace_Slice - 3");
      end;


      -- Function Replace_Slice

      TC_Set_Name ("Replace_Slice");

      if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x"))
                                           /= "abxde"  or -- High = Low
         TC_Check (ASF.Replace_Slice("abc",   2, 3, "xyz")) /= "axyz"   or
         TC_Check (ASF.Replace_Slice("abcd",  4, 1, "xy"))
                                           /= "abcxyd" or -- High < Low
         TC_Check (ASF.Replace_Slice("abc",   2, 3, "x"))   /= "ax"     or
         TC_Check (ASF.Replace_Slice("a",     1, 1, "z"))   /= "z"
      then
         Report.Failed("Incorrect result from Function Replace_Slice - 1");
      end if;

      if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z"))
                                           /= "abcdz" or  -- By length 1
         TC_Check (ASF.Replace_Slice("abc",   1, 3, "xyz"))
                                           /= "xyz"   or  -- High > Low
         TC_Check (ASF.Replace_Slice("abc",   3, 2, "xy"))
                                           /= "abxyc" or  -- insert
         TC_Check (ASF.Replace_Slice("a",     1, 1, "xyz")) /= "xyz"
      then
         Report.Failed("Incorrect result from Function Replace_Slice - 2");
      end if;



      -- Function Insert.

      TC_Set_Name ("Insert");

      declare
         New_String : constant String :=
           TC_Check (
              ASF.Insert(Source   => Source_String1(2..5),    -- "bcde"
                         Before   => 3,
                         New_Item => Source_String2));         -- "abcdef"
      begin
         if New_String /= "babcdefcde" then
            Report.Failed("Incorrect result from Function Insert - 1");
         end if;
      end;

      if TC_Check (ASF.Insert("a",   1, "z")) /= "za"   or
         TC_Check (ASF.Insert("abc", 3, ""))  /= "abc"  or
         TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc"
      then
         Report.Failed("Incorrect result from Function Insert - 2");
      end if;

      begin
         if TC_Check (ASF.Insert(Source   => Source_String1(2..5), -- "bcde"
                         Before   => Report.Ident_Int(7),
                         New_Item => Source_String2))         -- "abcdef"
                /= "babcdefcde" then
            Report.Failed("Index_Error not raised by Insert - 3A");
         else
            Report.Failed("Index_Error not raised by Insert - 3B");