gcc/testsuite/ada/acats/tests/cxa/cxa4002.a

   1 -- CXA4002.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.Fixed are
  28 --      available, and that they produce correct results.  Specifically,
  29 --      check the subprograms Index, "*" (string constructor function),
  30 --      Count, Trim, and Replace_Slice.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      This test demonstrates how certain Fixed string functions are used
  34 --      to eliminate specific substrings from portions of text.  A procedure
  35 --      is defined that will take as parameters a source string along with
  36 --      a substring that is to be completely removed from the source string.
  37 --      The source string is parsed using the Index function, and any substring
  38 --      slices are replaced in the source string by a series of X's (based on
  39 --      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.Fixed;
  54 with Ada.Strings.Maps;
  55 with Report;
  56
  57 procedure CXA4002 is
  58
  59 begin
  60
  61    Report.Test ("CXA4002", "Check that the subprograms defined in package "  &
  62                            "Ada.Strings.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
  71       type Restricted_Words_Array_Type is array (1..10) of String (1..10);
  72
  73       Restricted_Words : Restricted_Words_Array_Type :=
  74                            ("   platoon", " marines  ", "  Marines ",
  75                             "north     ", "south     ", "      east",
  76                             "  beach   ", "   airport", "airfield  ",
  77                             "     road ");
  78
  79       subtype Line_Of_Text_Type is String(1..25);
  80       type    Page_Of_Text_Type is array (1..Number_Of_Lines)
  81         of Line_Of_Text_Type;
  82
  83       Text_Page : Page_Of_Text_Type := ("The platoon of Marines   ",
  84                                         "moved south on the south ",
  85                                         "road to the airfield.    ");
  86
  87       TC_Revised_Line_1 : constant String := "The XXXXXXX of XXXXXXX   ";
  88       TC_Revised_Line_2 : constant String := "moved XXXXX on the XXXXX ";
  89       TC_Revised_Line_3 : constant String := "XXXX to the XXXXXXXX.    ";
  90
  91       ---
  92
  93       procedure Censor (Source_String  : in out String;
  94                         Pattern_String : in     String) is
  95
  96          -- Create a replacement string that is the same length as the
  97          -- pattern string being removed.
  98          Replacement : constant String :=                              -- "*"
  99                          Ada.Strings.Fixed."*"(Pattern_String'Length, 'X');
 100
 101          Going       : Ada.Strings.Direction := Ada.Strings.Forward;
 102          Map         : constant Ada.Strings.Maps.Character_Mapping :=
 103                          Ada.Strings.Maps.Identity;
 104          Start_Pos,
 105          Index       : Natural := Source_String'First;
 106
 107
 108       begin  -- Censor
 109
 110          -- Accumulate count of total replacement operations.
 111
 112          TC_Total := TC_Total +                                     -- Count
 113                        Ada.Strings.Fixed.Count (Source  => Source_String,
 114                                                 Pattern => Pattern_String,
 115                                                 Mapping => Map);
 116          loop
 117
 118             Index := Ada.Strings.Fixed.Index                        -- Index
 119                        (Source_String(Start_Pos..Source_String'Last),
 120                         Pattern_String,
 121                         Going,
 122                         Map);
 123
 124             exit when Index = 0;   -- No matches, exit loop.
 125
 126             -- if a match was found, modify the substring.
 127             Ada.Strings.Fixed.Replace_Slice                   -- Replace_Slice
 128                                 (Source_String,
 129                                  Index,
 130                                  Index + Pattern_String'Length - 1,
 131                                  Replacement);
 132             Start_Pos := Index + Pattern_String'Length;
 133
 134          end loop;
 135
 136       end Censor;
 137
 138
 139    begin
 140
 141       -- Invoke Censor subprogram to cleanse text.
 142       -- Loop through each line of text, and check for the presence of each
 143       -- restricted word.
 144       -- Use the Trim function to eliminate leading or trailing blanks from
 145       -- the restricted word parameters.
 146
 147       for Line in 1..Number_Of_Lines loop
 148          for Word in Restricted_Words'Range loop
 149              Censor (Text_Page(Line),
 150                      Ada.Strings.Fixed.Trim(Restricted_Words(Word),   -- Trim
 151                                             Ada.Strings.Both));
 152          end loop;
 153       end loop;
 154
 155
 156       -- Validate results.
 157
 158       if TC_Total /= 6 then
 159          Report.Failed ("Incorrect number of substitutions performed");
 160       end if;
 161
 162       if Text_Page(1) /= TC_Revised_Line_1 then
 163          Report.Failed ("Incorrect substitutions on Line 1");
 164       end if;
 165
 166       if Text_Page(2) /= TC_Revised_Line_2 then
 167          Report.Failed ("Incorrect substitutions on Line 2");
 168       end if;
 169
 170       if Text_Page(3) /= TC_Revised_Line_3 then
 171          Report.Failed ("Incorrect substitutions on Line 3");
 172       end if;
 173
 174
 175    exception
 176       when others => Report.Failed ("Exception raised in Test_Block");
 177    end Test_Block;
 178
 179
 180    Report.Result;
 181
 182 end CXA4002;