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

-- CXA4026.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 Ada.Strings.Fixed procedures Head, Tail, and Trim, as well 
--      as the versions of subprograms Translate (procedure and function), 
--      Index, and Count, available in the package which use a 
--      Maps.Character_Mapping_Function input parameter, produce correct 
--      results.
--
-- TEST DESCRIPTION:
--      This test examines the operation of several subprograms contained in
--      the Ada.Strings.Fixed package.  
--      This includes procedure versions of Head, Tail, and Trim, as well as
--      four subprograms that use a Character_Mapping_Function as a parameter 
--      to provide the 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.
--
--      Results of all subprograms are compared with expected results.
--      
--       
-- CHANGE HISTORY:
--      10 Feb 95   SAIC    Initial prerelease version
--      21 Apr 95   SAIC    Modified definition of string variable Str_2.
--
--!


package CXA4026_0 is

   -- Function Map_To_Lower_Case will return the lower case form of 
   -- Characters in the range 'A'..'Z' only, and return the input
   -- character otherwise.

   function Map_To_Lower_Case (From : Character) return Character;


   -- Function Map_To_Upper_Case 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.               

   function Map_To_Upper_Case (From : Character) return Character;

end CXA4026_0;


with Ada.Characters.Handling;
package body CXA4026_0 is

   function Map_To_Lower_Case (From : Character) return Character is
   begin
      if From in 'A'..'Z' then
         return Character'Val(Character'Pos(From) -
                             (Character'Pos('A') - Character'Pos('a')));
      else
         return From;
      end if;
   end Map_To_Lower_Case;

   function Map_To_Upper_Case (From : Character) return Character is
   begin
      return Ada.Characters.Handling.To_Upper(From);
   end Map_To_Upper_Case;

end CXA4026_0;


with CXA4026_0;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Report;

procedure CXA4026 is

begin

   Report.Test ("CXA4026", "Check that procedures Trim, Head, and Tail, " &
                           "as well as the versions of subprograms "      &
                           "Translate, Index, and Count, which use the "  &
                           "Character_Mapping_Function input parameter,"  &
                           "produce correct results");

   Test_Block:
   declare

      use Ada.Strings, CXA4026_0;

      -- The following strings are used in examination of the Translation
      -- subprograms.

      New_Character_String : String(1..10) :=
                               Ada.Characters.Latin_1.LC_A_Grave          &
                               Ada.Characters.Latin_1.LC_A_Ring           &
                               Ada.Characters.Latin_1.LC_AE_Diphthong     &
                               Ada.Characters.Latin_1.LC_C_Cedilla        &
                               Ada.Characters.Latin_1.LC_E_Acute          &
                               Ada.Characters.Latin_1.LC_I_Circumflex     &
                               Ada.Characters.Latin_1.LC_Icelandic_Eth    &
                               Ada.Characters.Latin_1.LC_N_Tilde          &
                               Ada.Characters.Latin_1.LC_O_Oblique_Stroke &
                               Ada.Characters.Latin_1.LC_Icelandic_Thorn;  
 

      TC_New_Character_String : String(1..10) :=
                               Ada.Characters.Latin_1.UC_A_Grave          &
                               Ada.Characters.Latin_1.UC_A_Ring           &
                               Ada.Characters.Latin_1.UC_AE_Diphthong     &
                               Ada.Characters.Latin_1.UC_C_Cedilla        &
                               Ada.Characters.Latin_1.UC_E_Acute          &
                               Ada.Characters.Latin_1.UC_I_Circumflex     &
                               Ada.Characters.Latin_1.UC_Icelandic_Eth    &
                               Ada.Characters.Latin_1.UC_N_Tilde          &
                               Ada.Characters.Latin_1.UC_O_Oblique_Stroke &
                               Ada.Characters.Latin_1.UC_Icelandic_Thorn;  


      -- Functions used to supply mapping capability.


      -- Access objects that will be provided as parameters to the 
      -- subprograms.

      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;


   begin

      -- Function Index, Forward direction search.
      -- Note: Several of the following cases use the default value
      --       Forward for the Going parameter.

      if Fixed.Index(Source => "The library package Strings.Fixed",
                     Pattern => "fix",
                     Going   => Ada.Strings.Forward,
                     Mapping => Map_To_Lower_Case_Ptr)    /= 29   or
         Fixed.Index("THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN",
                     "ain",
                     Mapping => Map_To_Lower_Case_Ptr)    /= 6    or
         Fixed.Index("maximum number",
                     "um",
                     Ada.Strings.Forward,
                     Map_To_Lower_Case_Ptr)               /= 6    or
         Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg",
                     "MIXED CASE STRING",
                     Ada.Strings.Forward,
                     Map_To_Upper_Case_Ptr)               /= 12   or
         Fixed.Index("STRING WITH NO MATCHING PATTERNS",
                     "WITH",
                     Ada.Strings.Forward,
                     Map_To_Lower_Case_Ptr)               /= 0    or
         Fixed.Index("THIS STRING IS IN UPPER CASE",
                     "IS",
                     Ada.Strings.Forward,
                     Map_To_Upper_Case_Ptr)               /= 3    or
         Fixed.Index("",  -- Null string.
                     "is",
                     Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
         Fixed.Index("AAABBBaaabbb",
                     "aabb",
                     Mapping => Map_To_Lower_Case_Ptr)    /= 2
      then
         Report.Failed("Incorrect results from Function Index, going "    &
                       "in Forward direction, using a Character Mapping " &
                       "Function parameter");
      end if;



      -- Function Index, Backward direction search.

      if Fixed.Index("Case of a Mixed Case String", 
                     "case", 
                     Ada.Strings.Backward,
                     Map_To_Lower_Case_Ptr)               /= 17   or
         Fixed.Index("Case of a Mixed Case String", 
                     "CASE", 
                     Ada.Strings.Backward,
                     Map_To_Upper_Case_Ptr)               /= 17   or
         Fixed.Index("rain, Rain, and more RAIN",
                     "rain",
                     Ada.Strings.Backward,
                     Map_To_Lower_Case_Ptr)               /= 22   or
         Fixed.Index("RIGHT place, right time",
                     "RIGHT",
                     Ada.Strings.Backward,
                     Map_To_Upper_Case_Ptr)               /= 14   or
         Fixed.Index("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, going "     &
                       "in Backward direction, using a Character Mapping " &
                       "Function parameter");
      end if;



      -- Function Index, Pattern_Error if Pattern = Null_String

      declare
         use Ada.Strings.Fixed;
         Null_Pattern_String : constant String := "";
         TC_Natural          : Natural         := 1000;
      begin
         TC_Natural := Index("A Valid String", 
                             Null_Pattern_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 Fixed.Count(Source  => "ABABABA",        
                     Pattern => "aba",
                     Mapping => Map_To_Lower_Case_Ptr)        /=  2   or
         Fixed.Count("ABABABA", "ABA", Map_To_Lower_Case_Ptr) /=  0   or
         Fixed.Count("This IS a MISmatched issue",
                     "is",
                     Map_To_Lower_Case_Ptr)                   /=  4   or
         Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /=  2   or
         Fixed.Count("This IS a MISmatched issue",
                     "is",
                     Map_To_Upper_Case_Ptr)                   /=  0   or
         Fixed.Count("She sells sea shells by the sea shore",
                     "s",
                     Map_To_Lower_Case_Ptr)                   /=  8   or
         Fixed.Count("",                       -- Null string.
                     "match",
                     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 Ada.Strings.Fixed;
         Null_Pattern_String : constant String := "";
         TC_Natural          : Natural         := 1000;
      begin
         TC_Natural := Count("A Valid String", 
                             Null_Pattern_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 Fixed.Translate(Source  => "A Sample Mixed Case String",
                         Mapping => Map_To_Lower_Case_Ptr) /= 
         "a sample mixed case string"                         or

         Fixed.Translate("ALL LOWER CASE",
                         Map_To_Lower_Case_Ptr)            /= 
         "all lower case"                                     or

         Fixed.Translate("end with lower case",
                         Map_To_Lower_Case_Ptr)            /= 
         "end with lower case"                                or

         Fixed.Translate("", Map_To_Lower_Case_Ptr)        /=
         ""                                                   or

         Fixed.Translate("start with lower case",
                         Map_To_Upper_Case_Ptr)            /= 
         "START WITH LOWER CASE"                              or

         Fixed.Translate("ALL UPPER CASE STRING",
                         Map_To_Upper_Case_Ptr)            /=
         "ALL UPPER CASE STRING"                              or

         Fixed.Translate("LoTs Of MiXeD CaSe ChArAcTeRs",
                         Map_To_Upper_Case_Ptr)            /=
         "LOTS OF MIXED CASE CHARACTERS"                      or

         Fixed.Translate("", Map_To_Upper_Case_Ptr)        /=
         ""                                                   or

         Fixed.Translate(New_Character_String,
                         Map_To_Upper_Case_Ptr)            /=
         TC_New_Character_String
      then
         Report.Failed("Incorrect results from Function Translate, using " &
                       "a Character Mapping Function parameter");
      end if;



      -- Procedure Translate.

      declare

         use Ada.Strings.Fixed;

         Str_1    : String(1..24)   := "AN ALL UPPER CASE STRING";
         Str_2    : String(1..19)   := "A Mixed Case String";
         Str_3    : String(1..32)   := "a string with lower case letters";
         TC_Str_1 : constant String := Str_1;
         TC_Str_3 : constant String := Str_3;

      begin

         Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);

         if Str_1 /= "an all upper case string" then
            Report.Failed("Incorrect result from Procedure Translate - 1");
         end if;

         Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);

         if Str_1 /= TC_Str_1 then
            Report.Failed("Incorrect result from Procedure Translate - 2");
         end if;

         Translate(Source => Str_2, Mapping => Map_To_Lower_Case_Ptr);

         if Str_2 /= "a mixed case string" then
            Report.Failed("Incorrect result from Procedure Translate - 3");
         end if;

         Translate(Source => Str_2, Mapping => Map_To_Upper_Case_Ptr);

         if Str_2 /= "A MIXED CASE STRING" then
            Report.Failed("Incorrect result from Procedure Translate - 4");
         end if;

         Translate(Source => Str_3, Mapping => Map_To_Lower_Case_Ptr);

         if Str_3 /= TC_Str_3 then
            Report.Failed("Incorrect result from Procedure Translate - 5");
         end if;

         Translate(Source => Str_3, Mapping => Map_To_Upper_Case_Ptr);

         if Str_3 /= "A STRING WITH LOWER CASE LETTERS" then
            Report.Failed("Incorrect result from Procedure Translate - 6");
         end if;

         Translate(New_Character_String, Map_To_Upper_Case_Ptr);

         if New_Character_String /= TC_New_Character_String then
            Report.Failed("Incorrect result from Procedure Translate - 6");
         end if;

      end;


      -- Procedure Trim.

      declare
         Use Ada.Strings.Fixed;
         Trim_String : String(1..30) := "    A string of characters    ";
      begin

         Trim(Source  => Trim_String,
              Side    => Ada.Strings.Left,
              Justify => Ada.Strings.Right,
              Pad     => 'x');
         
         if Trim_String /= "xxxxA string of characters    " then
            Report.Failed("Incorrect result from Procedure Trim, trim " &
                          "side = left, justify = right, pad = x");
         end if;

         Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center);

         if Trim_String /= "  xxxxA string of characters  " then
            Report.Failed("Incorrect result from Procedure Trim, trim " &
                          "side = right, justify = center, default pad");
         end if;

         Trim(Trim_String, Ada.Strings.Both, Pad => '*');

         if Trim_String /= "xxxxA string of characters****" then
            Report.Failed("Incorrect result from Procedure Trim, trim " &
                          "side = both, default justify, pad = *");
         end if;

      end;


      -- Procedure Head.

      declare
         Fixed_String : String(1..20) := "A sample test string";
      begin

         Fixed.Head(Source  => Fixed_String,
                    Count   => 14,
                    Justify => Ada.Strings.Center,
                    Pad     => '$');

         if Fixed_String /= "$$$A sample test $$$" then
            Report.Failed("Incorrect result from Procedure Head, " &
                          "justify = center, pad = $");
         end if;

         Fixed.Head(Fixed_String, 11, Ada.Strings.Right);

         if Fixed_String /= "         $$$A sample" then
            Report.Failed("Incorrect result from Procedure Head, " &
                          "justify = right, default pad");
         end if;

         Fixed.Head(Fixed_String, 9, Pad => '*');
 
         if Fixed_String /= "         ***********" then
            Report.Failed("Incorrect result from Procedure Head, " &
                          "default justify, pad = *");
         end if;

      end;


      -- Procedure Tail.

      declare
         Use Ada.Strings.Fixed;
         Tail_String : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
      begin

         Tail(Source => Tail_String, Count => 10, Pad => '-');

         if Tail_String /= "KLMNOPQRST----------" then
            Report.Failed("Incorrect result from Procedure Tail, " &
                          "default justify, pad = -");
         end if;

         Tail(Tail_String, 6, Justify => Ada.Strings.Center, Pad => 'a');

         if Tail_String /= "aaaaaaa------aaaaaaa" then
            Report.Failed("Incorrect result from Procedure Tail, " &
                          "justify = center, pad = a");
         end if;

         Tail(Tail_String, 1, Ada.Strings.Right);

         if Tail_String /= "                   a" then
            Report.Failed("Incorrect result from Procedure Tail, " &
                          "justify = right, default pad");
         end if;

         Tail(Tail_String, 19, Ada.Strings.Right, 'A');

         if Tail_String /= "A                  a" then
            Report.Failed("Incorrect result from Procedure Tail, " &
                          "justify = right, pad = A");
         end if;

      end;

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


   Report.Result;

end CXA4026;