Subversion Repositories openrisc

-- CXA4027.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 versions of Ada.Strings.Bounded subprograms Translate,

--      (procedure and function), Index, and Count, which use the

--      Maps.Character_Mapping_Function input parameter, produce correct

--      results.

--

-- TEST DESCRIPTION:

--      This test examines the operation of several subprograms from within

--      the Ada.Strings.Bounded package that use the

--      Character_Mapping_Function mapping parameter to provide a mapping

--      capability.

--

--      Two functions are defined to provide the mapping.  Access values

--      are defined to refer to these functions.  One of the functions will

--      map upper case characters in the range 'A'..'Z' to their lower case

--      counterparts, while the other function will map lower case characters

--      ('a'..'z', or a character whose position is in one of the ranges

--      223..246 or 248..255, provided the character has an upper case form)

--      to their upper case form.

--

--      Function Index uses the mapping function access value to map the input

--      string prior to searching for the appropriate index value to return.

--      Function Count uses the mapping function access value to map the input

--      string prior to counting the occurrences of the pattern string.

--      Both the Procedure and Function version of Translate use the mapping

--      function access value to perform the translation.

--

--

-- CHANGE HISTORY:

--      16 FEB 95   SAIC    Initial prerelease version

--      17 Jul 95   SAIC    Incorporated reviewer comments.  Replaced two

--                          internally declared functions with two library

--                          level functions to eliminate accessibility

--                          problems.

--

--!

-- Function CXA4027_0 will return the lower case form of

-- the character input if it is in upper case, and return the input

-- character otherwise.

with Ada.Characters.Handling;

function CXA4027_0 (From : Character) return Character;

function CXA4027_0 (From : Character) return Character is

begin

   return Ada.Characters.Handling.To_Lower(From);

end CXA4027_0;

-- Function CXA4027_1 will return the upper case form of

-- Characters in the range 'a'..'z', or whose position is in one

-- of the ranges 223..246 or 248..255, provided the character has

-- an upper case form.

with Ada.Characters.Handling;

function CXA4027_1 (From : Character) return Character;

function CXA4027_1 (From : Character) return Character is

begin

   return Ada.Characters.Handling.To_Upper(From);

end CXA4027_1;

with CXA4027_0, CXA4027_1;

with Ada.Strings.Bounded;

with Ada.Strings.Maps;

with Ada.Characters.Handling;

with Report;

procedure CXA4027 is

begin

   Report.Test ("CXA4027", "Check that Ada.Strings.Bounded subprograms "  &

                           "Translate, Index, and Count, which use the "  &

                           "Character_Mapping_Function input parameter, " &

                           "produce correct results");

   Test_Block:

   declare

      use Ada.Strings;

      -- Functions used to supply mapping capability.

      function Map_To_Lower_Case (From : Character) return Character

        renames CXA4027_0;

      function Map_To_Upper_Case (From : Character) return Character

        renames CXA4027_1;

      Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=

                                Map_To_Lower_Case'Access;

      Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=

                                Map_To_Upper_Case'Access;

      -- Instantiations of Bounded String generic package.

      package BS1  is new Ada.Strings.Bounded.Generic_Bounded_Length(1);

      package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20);

      package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40);

      package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);

      use type BS1.Bounded_String,  BS20.Bounded_String,

               BS40.Bounded_String, BS80.Bounded_String;

      String_1   : String(1..1)  := "A";

      String_20  : String(1..20) := "ABCDEFGHIJKLMNOPQRST";

      String_40  : String(1..40) := "abcdefghijklmnopqrst" & String_20;

      String_80  : String(1..80) := String_40 & String_40;

      BString_1  : BS1.Bounded_String  := BS1.Null_Bounded_String;

      BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String;

      BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String;

      BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String;

   begin

      -- Function Index.

      if BS40.Index(BS40.To_Bounded_String("Package Strings.Bounded"),

                    Pattern => "s.b",

                    Going   => Ada.Strings.Forward,

                    Mapping => Map_To_Lower_Case_Ptr)     /= 15  or

         BS80.Index(BS80.To_Bounded_String("STRING TRANSLATIONS SUBPROGRAMS"),

                    "tr",

                    Mapping => Map_To_Lower_Case_Ptr)     /= 2   or

         BS20.Index(BS20.To_Bounded_String("maximum number"),

                    "um",

                    Ada.Strings.Backward,

                    Map_To_Lower_Case_Ptr)                /= 10  or

         BS80.Index(BS80.To_Bounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),

                    "MIXED CASE STRING",

                    Ada.Strings.Forward,

                    Map_To_Upper_Case_Ptr)                /= 12  or

         BS40.Index(BS40.To_Bounded_String("STRING WITH NO MATCHING PATTERN"),

                    "WITH",

                    Ada.Strings.Backward,

                    Map_To_Lower_Case_Ptr)                /= 0   or

         BS80.Index(BS80.To_Bounded_String("THIS STRING IS IN UPPER CASE"),

                    "I",

                    Ada.Strings.Backward,

                    Map_To_Upper_Case_Ptr)                /= 16  or

         BS1.Index(BS1.Null_Bounded_String,

                   "i",

                   Mapping => Map_To_Lower_Case_Ptr)      /= 0   or

         BS40.Index(BS40.To_Bounded_String("AAABBBaaabbb"),

                    "aabb",

                    Mapping => Map_To_Lower_Case_Ptr)     /= 2   or

         BS80.Index(BS80.To_Bounded_String("WOULD MATCH BUT FOR THE CASE"),

                    "WOULD MATCH BUT FOR THE CASE",

                    Ada.Strings.Backward,

                    Map_To_Lower_Case_Ptr)                /= 0

      then

         Report.Failed("Incorrect results from Function Index, using a " &

                       "Character Mapping Function parameter");

      end if;

      -- Function Index, Pattern_Error if Pattern = Null_String

      declare

         use BS20;

         TC_Natural : Natural := 1000;

      begin

         TC_Natural := Index(To_Bounded_String("A Valid String"),

                             "",

                             Ada.Strings.Forward,

                             Map_To_Lower_Case_Ptr);

         Report.Failed("Pattern_Error not raised by Function Index when " &

                       "given a null pattern string");

      exception

         when Pattern_Error => null;   -- OK, expected exception.

         when others        =>

            Report.Failed("Incorrect exception raised by Function Index " &

                          "using a Character_Mapping_Function parameter " &

                          "when given a null pattern string");

      end;

      -- Function Count.

      if BS20.Count(BS20.To_Bounded_String("ABABABA"),

                    Pattern => "aba",

                    Mapping => Map_To_Lower_Case_Ptr)        /=  2   or

         BS20.Count(BS20.To_Bounded_String("ABABABA"),

                    "ABA",

                    Map_To_Lower_Case_Ptr)                   /=  0   or

         BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),

                    "is",

                    Map_To_Lower_Case_Ptr)                   /=  4   or

         BS80.Count(BS80.To_Bounded_String("ABABABA"),

                    "ABA",

                    Map_To_Upper_Case_Ptr)                   /=  2   or

         BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),

                    "is",

                    Map_To_Upper_Case_Ptr)                   /=  0   or

         BS80.Count(BS80.To_Bounded_String

                           ("Peter Piper and his Pickled Peppers"),

                    "p",

                    Map_To_Lower_Case_Ptr)                   /=  7   or

         BS20.Count(BS20.To_Bounded_String("She sells sea shells"),

                    "s",

                    Map_To_Upper_Case_Ptr)                   /=  0   or

         BS80.Count(BS80.To_Bounded_String("No matches what-so-ever"),

                    "matches",

                    Map_To_Upper_Case_Ptr)                   /=  0

      then

         Report.Failed("Incorrect results from Function Count, using " &

                       "a Character_Mapping_Function parameter");

      end if;

      -- Function Count, Pattern_Error if Pattern = Null_String

      declare

         use BS80;

         TC_Natural : Natural := 1000;

      begin

         TC_Natural := Count(To_Bounded_String("A Valid String"),

                             "",

                             Map_To_Lower_Case_Ptr);

         Report.Failed("Pattern_Error not raised by Function Count using " &

                       "a Character_Mapping_Function parameter when "      &

                       "given a null pattern string");

      exception

         when Pattern_Error => null;   -- OK, expected exception.

         when others        =>

            Report.Failed("Incorrect exception raised by Function Count " &

                          "using a Character_Mapping_Function parameter " &

                          "when given a null pattern string");

      end;

      -- Function Translate.

      if BS40.Translate(BS40.To_Bounded_String("A Mixed Case String"),

                        Mapping => Map_To_Lower_Case_Ptr) /=

         BS40.To_Bounded_String("a mixed case string")      or

         BS20."/="(BS20.Translate(BS20.To_Bounded_String("ALL LOWER CASE"),

                                  Map_To_Lower_Case_Ptr),

                   "all lower case")                        or

         BS20."/="("end with lower case",

                   BS20.Translate(

                     BS20.To_Bounded_String("end with lower case"),

                     Map_To_Lower_Case_Ptr))                or

         BS1.Translate(BS1.Null_Bounded_String,

                       Map_To_Lower_Case_Ptr)             /=

         BS1.Null_Bounded_String                            or

         BS80."/="(BS80.Translate(BS80.To_Bounded_String

                          ("start with lower case, end with upper case"),

                        Map_To_Upper_Case_Ptr),

                   "START WITH LOWER CASE, END WITH UPPER CASE") or

         BS40.Translate(BS40.To_Bounded_String("ALL UPPER CASE STRING"),

                        Map_To_Upper_Case_Ptr)            /=

         BS40.To_Bounded_String("ALL UPPER CASE STRING")    or

         BS80."/="(BS80.Translate(BS80.To_Bounded_String

                          ("LoTs Of MiXeD CaSe ChArAcTeRs In ThE StRiNg"),

                          Map_To_Upper_Case_Ptr),

                   "LOTS OF MIXED CASE CHARACTERS IN THE STRING")

      then

         Report.Failed("Incorrect results from Function Translate, using " &

                       "a Character_Mapping_Function parameter");

      end if;

      -- Procedure Translate.

      BString_1 := BS1.To_Bounded_String("A");

      BS1.Translate(Source => BString_1, Mapping => Map_To_Lower_Case_Ptr);

      if not BS1."="(BString_1, "a") then    -- "=" for Bounded_String, String

         Report.Failed("Incorrect result from Procedure Translate - 1");

      end if;

      BString_20 := BS20.To_Bounded_String(String_20);

      BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);

      if BString_20 /= BS20.To_Bounded_String("abcdefghijklmnopqrst") then

         Report.Failed("Incorrect result from Procedure Translate - 2");

      end if;

      BString_40 := BS40.To_Bounded_String("String needing highlighting");

      BS40.Translate(BString_40, Map_To_Upper_Case_Ptr);

      if not (BString_40 = "STRING NEEDING HIGHLIGHTING") then

         Report.Failed("Incorrect result from Procedure Translate - 3");

      end if;

      BString_80 := BS80.Null_Bounded_String;

      BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);

      if not (BString_80 = BS80.Null_Bounded_String) then

         Report.Failed("Incorrect result from Procedure Translate - 4");

      end if;

   exception

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

   end Test_Block;

   Report.Result;

end CXA4027;