Subversion Repositories openrisc_me

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