path: root/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a

-- 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");
         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;