old-autovect-branch/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a

   1 -- CXA4013.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that the subprograms defined in package Ada.Strings.Wide_Fixed
  28 --      are available, and that they produce correct results.  Specifically,
  29 --      check the subprograms Index, "*" (Wide_String constructor function),
  30 --      Count, Trim, and Replace_Slice.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      This test demonstrates how certain Wide_Fixed string functions
  34 --      are used to eliminate specific substrings from portions of text.
  35 --      A procedure is defined that will take as parameters a source
  36 --      Wide_String along with a substring that is to be completely removed
  37 --      from the source string.  The source Wide_String is parsed using the
  38 --      Index function, and any substring slices are replaced in the source
  39 --      Wide_String by a series of X's (based on the length of the substring.)
  40 --      Three lines of text are provided to this procedure, and the resulting
  41 --      substitutions are compared with expected results to validate the
  42 --      string processing.
  43 --      A global accumulator is updated with the number of occurrences of the
  44 --      substring in the source string.
  45 --
  46 --
  47 -- CHANGE HISTORY:
  48 --      06 Dec 94   SAIC    ACVC 2.0
  49 --
  50 --!
  51
  52 with Ada.Strings;
  53 with Ada.Strings.Wide_Fixed;
  54 with Ada.Strings.Wide_Maps;
  55 with Report;
  56
  57 procedure CXA4013 is
  58
  59 begin
  60
  61    Report.Test ("CXA4013", "Check that the subprograms defined in package "  &
  62                            "Ada.Strings.Wide_Fixed are available, and that " &
  63                            "they produce correct results");
  64
  65    Test_Block:
  66    declare
  67
  68       TC_Total        : Natural  := 0;
  69       Number_Of_Lines : constant := 3;
  70       WC              : Wide_Character :=
  71                           Wide_Character'Val(Character'Pos('X')            +
  72                                              Character'Pos(Character'Last) +
  73                                              1 );
  74
  75       subtype WS is Wide_String (1..25);
  76
  77       type Restricted_Words_Array_Type is
  78         array (1..10) of Wide_String (1..10);
  79
  80       Restricted_Words : Restricted_Words_Array_Type :=
  81                            ("   platoon", " marines  ", "  Marines ",
  82                             "north     ", "south     ", "      east",
  83                             "  beach   ", "   airport", "airfield  ",
  84                             "     road ");
  85
  86       type Page_Of_Text_Type is array (1..Number_Of_Lines) of WS;
  87
  88       Text_Page : Page_Of_Text_Type := ("The platoon of Marines   ",
  89                                         "moved south on the south ",
  90                                         "road to the airfield.    ");
  91
  92       TC_Revised_Line_1 : constant Wide_String := "The XXXXXXX of XXXXXXX   ";
  93       TC_Revised_Line_2 : constant Wide_String := "moved XXXXX on the XXXXX ";
  94       TC_Revised_Line_3 : constant Wide_String := "XXXX to the XXXXXXXX.    ";
  95
  96
  97       function Equivalent (Left : WS;  Right : Wide_String)
  98         return Boolean is
  99       begin
 100          for i in WS'range loop
 101             if Left(i) /= Right(i) then
 102                if Left(i) /= WC   or  Right(i) /= 'X' then
 103                   return False;
 104                end if;
 105             end if;
 106          end loop;
 107          return True;
 108       end Equivalent;
 109
 110       ---
 111
 112       procedure Censor (Source_String  : in out Wide_String;
 113                         Pattern_String : in     Wide_String) is
 114
 115          use Ada.Strings.Wide_Fixed; -- allows infix notation of "*" below.
 116
 117          -- Create a replacement string that is the same length as the
 118          -- pattern string being removed.  Use the infix notation of the
 119          -- wide string constructor function.
 120
 121          Replacement : constant Wide_String :=
 122                          Pattern_String'Length * WC;                 -- "*"
 123
 124          Going     : Ada.Strings.Direction := Ada.Strings.Forward;
 125          Start_Pos,
 126          Index     : Natural := Source_String'First;
 127
 128       begin  -- Censor
 129
 130          -- Accumulate count of total replacement operations.
 131
 132          TC_Total := TC_Total +
 133                       Ada.Strings.Wide_Fixed.Count                  -- Count
 134                         (Source  => Source_String,
 135                          Pattern => Pattern_String,
 136                          Mapping => Ada.Strings.Wide_Maps.Identity);
 137          loop
 138
 139             Index := Ada.Strings.Wide_Fixed.Index                   -- Index
 140                        (Source_String(Start_Pos..Source_String'Last),
 141                         Pattern_String,
 142                         Going,
 143                         Ada.Strings.Wide_Maps.Identity);
 144
 145             exit when Index = 0;   -- No matches, exit loop.
 146
 147             -- if a match was found, modify the substring.
 148             Ada.Strings.Wide_Fixed.Replace_Slice              -- Replace_Slice
 149                                      (Source_String,
 150                                       Index,
 151                                       Index + Pattern_String'Length - 1,
 152                                       Replacement);
 153             Start_Pos := Index + Pattern_String'Length;
 154
 155          end loop;
 156
 157       end Censor;
 158
 159
 160    begin
 161
 162       -- Invoke Censor subprogram to cleanse text.
 163       -- Loop through each line of text, and check for the presence of each
 164       -- restricted word.
 165       -- Use the Trim function to eliminate leading or trailing blanks from
 166       -- the restricted word parameters.
 167
 168       for Line in 1..Number_Of_Lines loop
 169          for Word in Restricted_Words'Range loop
 170              Censor (Text_Page(Line),                                 -- Trim
 171                      Ada.Strings.Wide_Fixed.Trim(Restricted_Words(Word),
 172                                                  Ada.Strings.Both));
 173          end loop;
 174       end loop;
 175
 176
 177       -- Validate results.
 178
 179       if TC_Total /= 6 then
 180          Report.Failed ("Incorrect number of substitutions performed");
 181       end if;
 182
 183       if not Equivalent (Text_Page(1), TC_Revised_Line_1) then
 184          Report.Failed ("Incorrect substitutions on Line 1");
 185       end if;
 186
 187       if not Equivalent (Text_Page(2), TC_Revised_Line_2) then
 188          Report.Failed ("Incorrect substitutions on Line 2");
 189       end if;
 190
 191       if not Equivalent (Text_Page(3), TC_Revised_Line_3) then
 192          Report.Failed ("Incorrect substitutions on Line 3");
 193       end if;
 194
 195
 196    exception
 197       when others => Report.Failed ("Exception raised in Test_Block");
 198    end Test_Block;
 199
 200
 201    Report.Result;
 202
 203 end CXA4013;