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 52with Ada.Strings; 53with Ada.Strings.Wide_Fixed; 54with Ada.Strings.Wide_Maps; 55with Report; 56 57procedure CXA4013 is 58 59begin 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 203end CXA4013; 204