cxa4005.a

来自「用于进行gcc测试」· A 代码 · 共 684 行 · 第 1/2 页

         end if;
      exception
         when Ada.Strings.Index_Error => null; -- OK, expected exception.
         when others                  =>
            Report.Failed("Incorrect exception from Insert - 3");
      end;


      -- Procedure Insert

      -- Drop = Right

      ASF.Insert(Source   => Insert_String,
                 Before   => 6,
                 New_Item => Source_String2,       -- "abcdef"
                 Drop     => Ada.Strings.Right);

      if Insert_String /= "     abcde" then  -- last char of New_Item dropped.
         Report.Failed("Incorrect result from Insert with Drop = Right");
      end if;

      -- Drop = Left

      ASF.Insert(Source   => Insert_String,     -- 10 char string
                 Before   => 2,                 -- 9 chars, 2..10 available
                 New_Item => Source_String3,    -- 12 characters long.
                 Drop     => Ada.Strings.Left); -- truncate from Left.

      if Insert_String /= "l    abcde" then     -- 10 chars, leading blank.
          Report.Failed("Incorrect result from Insert with Drop=Left");
      end if;

      -- Drop = Error

      begin
         ASF.Insert(Source   => Result_String,       -- 10 chars
                    Before   => Result_String'Last,
                    New_Item => "abcdefghijk",
                    Drop     => Ada.Strings.Error);
         Report.Failed("Exception not raised by Procedure Insert");
      exception
         when Ada.Strings.Length_Error => null; -- OK, expected exception
         when others                   =>
           Report.Failed("Incorrect exception raised by Procedure Insert");
      end;



      -- Function Overwrite

      TC_Set_Name ("Overwrite");

      Overwrite_String := TC_Check (
          ASF.Overwrite(Result_String,  -- 10 chars
                        1,              -- starting at pos=1
                        Source_String3(1..10)));

      if Overwrite_String /= Source_String3(1..10) then
         Report.Failed("Incorrect result from Function Overwrite - 1");
      end if;


      if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or
         TC_Check (ASF.Overwrite("a",      1, "xyz"))
                                           /= "xyz"    or  -- chars appended
         TC_Check (ASF.Overwrite("abc",    3, "   "))
                                           /= "ab   "  or  -- blanks appended
         TC_Check (ASF.Overwrite("abcde",  1, "z"  )) /= "zbcde"
      then
         Report.Failed("Incorrect result from Function Overwrite - 2");
      end if;



      -- Procedure Overwrite, with truncation.

      ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
                    Position => 1,
                    New_Item => Source_String3,      -- 12 characters.
                    Drop     => Ada.Strings.Left);

      if Overwrite_String /= "cdefghijkl" then
         Report.Failed("Incorrect result from Overwrite with Drop=Left");
      end if;

      -- The default drop value is Right, used here.

      ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
                    Position => 1,
                    New_Item => Source_String3);     -- 12 characters.

      if Overwrite_String /= "abcdefghij" then
         Report.Failed("Incorrect result from Overwrite with Drop=Right");
      end if;

      -- Drop = Error

      begin
         ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
                       Position => 1,
                       New_Item => Source_String3,      -- 12 characters.
                       Drop     => Ada.Strings.Error);
         Report.Failed("Exception not raised by Procedure Overwrite");
      exception
         when Ada.Strings.Length_Error => null; -- OK, expected exception.
         when others                   =>
            Report.Failed
              ("Incorrect exception raised by Procedure Overwrite");
      end;

      Overwrite_String := "ababababab";
      ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z");
      ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z");
      ASF.Overwrite(Overwrite_String, 5, "zz");

      if Overwrite_String /= "zbabzzabaz" then
         Report.Failed("Incorrect result from Procedure Overwrite");
      end if;



      -- Function Delete

      TC_Set_Name ("Delete");

      declare
         New_String1 : constant String :=    -- This returns a 4 char string.
           TC_Check (ASF.Delete(Source  => Source_String3,
                                From    => 3,
                                Through => 10));
         New_String2 : constant String :=    -- This returns Source.
           TC_Check (ASF.Delete(Source_String3, 10, 3));
      begin
           if New_String1 /= "abkl"  or
              New_String2 /= Source_String3
           then
               Report.Failed("Incorrect result from Function Delete - 1");
           end if;
      end;

      if TC_Check (ASF.Delete("a",   1, 1))
                              /= ""    or     -- Source length = 1
         TC_Check (ASF.Delete("abc", 1, 2))
                              /= "c"   or     -- From = Source'First
         TC_Check (ASF.Delete("abc", 3, 3))
                              /= "ab"  or     -- From = Source'Last
         TC_Check (ASF.Delete("abc", 3, 1))
                              /= "abc"        -- From > Through
      then
         Report.Failed("Incorrect result from Function Delete - 2");
      end if;



      -- Procedure Delete

      -- Justify = Left

      Delete_String := Source_String3(1..10);  -- Initialize to "abcdefghij"

      ASF.Delete(Source  => Delete_String,
                 From    => 6,
                 Through => Delete_String'Last,
                 Justify => Ada.Strings.Left,
                 Pad     => 'x');              -- pad with char 'x'

      if Delete_String /= "abcdexxxxx" then
          Report.Failed("Incorrect result from Delete - Justify = Left");
      end if;

      -- Justify = Right

      ASF.Delete(Source  => Delete_String,      -- Remove x"s from end and
                 From    => 6,                  -- shift right.
                 Through => Delete_String'Last,
                 Justify => Ada.Strings.Right,
                 Pad     => 'x');               -- pad with char 'x' on left.

      if Delete_String /= "xxxxxabcde" then
          Report.Failed("Incorrect result from Delete - Justify = Right");
      end if;

      -- Justify = Center

      ASF.Delete(Source  => Delete_String,
                 From    => 1,
                 Through => 5,
                 Justify => Ada.Strings.Center,
                 Pad     => 'z');

      if Delete_String /= "zzabcdezzz" then  -- extra pad char on right side.
          Report.Failed("Incorrect result from Delete - Justify = Center");
      end if;



      -- Function Trim
      -- Use non-identity character sets to perform the trim operation.

      TC_Set_Name ("Trim");

      Trim_String := "cdabcdefcd";

      -- Remove the "cd" from each end of the string.  This will not effect
      -- the "cd" slice at 5..6.

      declare
         New_String : constant String :=
           TC_Check (ASF.Trim(Source => Trim_String,
                              Left => CD_Set, Right => CD_Set));
      begin
         if New_String /= Source_String2 then    -- string "abcdef"
            Report.Failed("Incorrect result from Trim with character sets");
         end if;
      end;

      if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set))
             /= "abcdef" then
         Report.Failed("Incorrect result from Trim with Null sets");
      end if;

      if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then
         Report.Failed("Incorrect result from Trim, string removal");
      end if;


      -- Procedure Trim

      -- Justify = Right

      ASF.Trim(Source  => Trim_String,
               Left    => CD_Set,
               Right   => CD_Set,
               Justify => Ada.Strings.Right,
               Pad     => 'x');

      if Trim_String /= "xxxxabcdef" then
         Report.Failed("Incorrect result from Trim with Justify = Right");
      end if;

      -- Justify = Left

      ASF.Trim(Source  => Trim_String,
               Left    => X_Set,
               Right   => Maps.Null_Set,
               Justify => Ada.Strings.Left,
               Pad     => Ada.Strings.Space);

      if Trim_String /= "abcdef    " then  -- Padded with 4 blanks on right.
         Report.Failed("Incorrect result from Trim with Justify = Left");
      end if;

      -- Justify = Center

      ASF.Trim(Source  => Trim_String,
               Left    => ABCD_Set,
               Right   => CD_Set,
               Justify => Ada.Strings.Center,
               Pad     => 'x');

      if Trim_String /= "xxef    xx" then  -- Padded with 2 pad chars on L/R
         Report.Failed("Incorrect result from Trim with Justify = Center");
      end if;



      -- Function Head, demonstrating use of padding.

      TC_Set_Name ("Head");

      -- Use the characters of Source_String1 ("abcde") and pad the
      -- last five characters of Result_String with 'x' characters.


      Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x'));

      if Result_String /= "abcdexxxxx" then
         Report.Failed("Incorrect result from Function Head with padding");
      end if;

      if TC_Check (ASF.Head("  ab  ", 2))        /= "  "     or
         TC_Check (ASF.Head("a", 6, 'A'))        /= "aAAAAA" or
         TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc"    or
         TC_Check (ASF.Head(ASF.Head("abc  ", 7, 'x'), 10, 'X'))
                   /= "abc  xxXXX"
      then
         Report.Failed("Incorrect result from Function Head");
      end if;



      -- Function Tail, demonstrating use of padding.

      TC_Set_Name ("Tail");

      -- Use the characters of Source_String1 ("abcde") and pad the
      -- first five characters of Result_String with 'x' characters.

      Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x'));

      if Result_String /= "xxxxxabcde" then
         Report.Failed("Incorrect result from Function Tail with padding");
      end if;

      if TC_Check (ASF.Tail("abcde  ", 5))
                            /= "cde  "    or  -- blanks, back
         TC_Check (ASF.Tail("  abc ",  8, ' '))
                            /= "    abc " or  -- blanks, front/back
         TC_Check (ASF.Tail("",        5, 'Z'))
                            /= "ZZZZZ"    or  -- pad characters only
         TC_Check (ASF.Tail("abc",     0))
                            /= ""         or  -- null result
         TC_Check (ASF.Tail("abcdefgh", 3))
                            /= "fgh"      or
         TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'),
                  10,
                  'X'))              /= "XXXXx abc "
      then
         Report.Failed("Incorrect result from Function Tail");
      end if;


      -- Function "*"  - with (Natural, String) parameters

      TC_Set_Name ("""*""");

      if TC_Check (ASF."*"(3, Source_String1))       /= "abcdeabcdeabcde"  or
         TC_Check (ASF."*"(2, Source_String2))       /= Source_String6     or
         TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab"         or
         TC_Check (ASF."*"(0, Source_String1))       /= ""
      then
         Report.Failed("Incorrect result from Function ""*"" with strings");
      end if;

   exception
      when others => Report.Failed("Exception raised in Test_Block");
   end Test_Block;

   Report.Result;

end CXA4005;