|
111
|
1 -- CXA4027.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 versions of Ada.Strings.Bounded subprograms Translate,
|
|
|
28 -- (procedure and function), Index, and Count, which use the
|
|
|
29 -- Maps.Character_Mapping_Function input parameter, produce correct
|
|
|
30 -- results.
|
|
|
31 --
|
|
|
32 -- TEST DESCRIPTION:
|
|
|
33 -- This test examines the operation of several subprograms from within
|
|
|
34 -- the Ada.Strings.Bounded package that use the
|
|
|
35 -- Character_Mapping_Function mapping parameter to provide a mapping
|
|
|
36 -- capability.
|
|
|
37 --
|
|
|
38 -- Two functions are defined to provide the mapping. Access values
|
|
|
39 -- are defined to refer to these functions. One of the functions will
|
|
|
40 -- map upper case characters in the range 'A'..'Z' to their lower case
|
|
|
41 -- counterparts, while the other function will map lower case characters
|
|
|
42 -- ('a'..'z', or a character whose position is in one of the ranges
|
|
|
43 -- 223..246 or 248..255, provided the character has an upper case form)
|
|
|
44 -- to their upper case form.
|
|
|
45 --
|
|
|
46 -- Function Index uses the mapping function access value to map the input
|
|
|
47 -- string prior to searching for the appropriate index value to return.
|
|
|
48 -- Function Count uses the mapping function access value to map the input
|
|
|
49 -- string prior to counting the occurrences of the pattern string.
|
|
|
50 -- Both the Procedure and Function version of Translate use the mapping
|
|
|
51 -- function access value to perform the translation.
|
|
|
52 --
|
|
|
53 --
|
|
|
54 -- CHANGE HISTORY:
|
|
|
55 -- 16 FEB 95 SAIC Initial prerelease version
|
|
|
56 -- 17 Jul 95 SAIC Incorporated reviewer comments. Replaced two
|
|
|
57 -- internally declared functions with two library
|
|
|
58 -- level functions to eliminate accessibility
|
|
|
59 -- problems.
|
|
|
60 --
|
|
|
61 --!
|
|
|
62
|
|
|
63
|
|
|
64 -- Function CXA4027_0 will return the lower case form of
|
|
|
65 -- the character input if it is in upper case, and return the input
|
|
|
66 -- character otherwise.
|
|
|
67
|
|
|
68 with Ada.Characters.Handling;
|
|
|
69 function CXA4027_0 (From : Character) return Character;
|
|
|
70
|
|
|
71 function CXA4027_0 (From : Character) return Character is
|
|
|
72 begin
|
|
|
73 return Ada.Characters.Handling.To_Lower(From);
|
|
|
74 end CXA4027_0;
|
|
|
75
|
|
|
76
|
|
|
77
|
|
|
78 -- Function CXA4027_1 will return the upper case form of
|
|
|
79 -- Characters in the range 'a'..'z', or whose position is in one
|
|
|
80 -- of the ranges 223..246 or 248..255, provided the character has
|
|
|
81 -- an upper case form.
|
|
|
82
|
|
|
83 with Ada.Characters.Handling;
|
|
|
84 function CXA4027_1 (From : Character) return Character;
|
|
|
85
|
|
|
86 function CXA4027_1 (From : Character) return Character is
|
|
|
87 begin
|
|
|
88 return Ada.Characters.Handling.To_Upper(From);
|
|
|
89 end CXA4027_1;
|
|
|
90
|
|
|
91
|
|
|
92 with CXA4027_0, CXA4027_1;
|
|
|
93 with Ada.Strings.Bounded;
|
|
|
94 with Ada.Strings.Maps;
|
|
|
95 with Ada.Characters.Handling;
|
|
|
96 with Report;
|
|
|
97
|
|
|
98 procedure CXA4027 is
|
|
|
99 begin
|
|
|
100
|
|
|
101 Report.Test ("CXA4027", "Check that Ada.Strings.Bounded subprograms " &
|
|
|
102 "Translate, Index, and Count, which use the " &
|
|
|
103 "Character_Mapping_Function input parameter, " &
|
|
|
104 "produce correct results");
|
|
|
105
|
|
|
106 Test_Block:
|
|
|
107 declare
|
|
|
108
|
|
|
109 use Ada.Strings;
|
|
|
110
|
|
|
111 -- Functions used to supply mapping capability.
|
|
|
112
|
|
|
113 function Map_To_Lower_Case (From : Character) return Character
|
|
|
114 renames CXA4027_0;
|
|
|
115
|
|
|
116 function Map_To_Upper_Case (From : Character) return Character
|
|
|
117 renames CXA4027_1;
|
|
|
118
|
|
|
119 Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
|
|
|
120 Map_To_Lower_Case'Access;
|
|
|
121
|
|
|
122 Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
|
|
|
123 Map_To_Upper_Case'Access;
|
|
|
124
|
|
|
125
|
|
|
126 -- Instantiations of Bounded String generic package.
|
|
|
127
|
|
|
128 package BS1 is new Ada.Strings.Bounded.Generic_Bounded_Length(1);
|
|
|
129 package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20);
|
|
|
130 package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40);
|
|
|
131 package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
|
|
|
132
|
|
|
133 use type BS1.Bounded_String, BS20.Bounded_String,
|
|
|
134 BS40.Bounded_String, BS80.Bounded_String;
|
|
|
135
|
|
|
136 String_1 : String(1..1) := "A";
|
|
|
137 String_20 : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
|
|
|
138 String_40 : String(1..40) := "abcdefghijklmnopqrst" & String_20;
|
|
|
139 String_80 : String(1..80) := String_40 & String_40;
|
|
|
140
|
|
|
141 BString_1 : BS1.Bounded_String := BS1.Null_Bounded_String;
|
|
|
142 BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String;
|
|
|
143 BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String;
|
|
|
144 BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String;
|
|
|
145
|
|
|
146
|
|
|
147 begin
|
|
|
148
|
|
|
149 -- Function Index.
|
|
|
150
|
|
|
151 if BS40.Index(BS40.To_Bounded_String("Package Strings.Bounded"),
|
|
|
152 Pattern => "s.b",
|
|
|
153 Going => Ada.Strings.Forward,
|
|
|
154 Mapping => Map_To_Lower_Case_Ptr) /= 15 or
|
|
|
155 BS80.Index(BS80.To_Bounded_String("STRING TRANSLATIONS SUBPROGRAMS"),
|
|
|
156 "tr",
|
|
|
157 Mapping => Map_To_Lower_Case_Ptr) /= 2 or
|
|
|
158 BS20.Index(BS20.To_Bounded_String("maximum number"),
|
|
|
159 "um",
|
|
|
160 Ada.Strings.Backward,
|
|
|
161 Map_To_Lower_Case_Ptr) /= 10 or
|
|
|
162 BS80.Index(BS80.To_Bounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),
|
|
|
163 "MIXED CASE STRING",
|
|
|
164 Ada.Strings.Forward,
|
|
|
165 Map_To_Upper_Case_Ptr) /= 12 or
|
|
|
166 BS40.Index(BS40.To_Bounded_String("STRING WITH NO MATCHING PATTERN"),
|
|
|
167 "WITH",
|
|
|
168 Ada.Strings.Backward,
|
|
|
169 Map_To_Lower_Case_Ptr) /= 0 or
|
|
|
170 BS80.Index(BS80.To_Bounded_String("THIS STRING IS IN UPPER CASE"),
|
|
|
171 "I",
|
|
|
172 Ada.Strings.Backward,
|
|
|
173 Map_To_Upper_Case_Ptr) /= 16 or
|
|
|
174 BS1.Index(BS1.Null_Bounded_String,
|
|
|
175 "i",
|
|
|
176 Mapping => Map_To_Lower_Case_Ptr) /= 0 or
|
|
|
177 BS40.Index(BS40.To_Bounded_String("AAABBBaaabbb"),
|
|
|
178 "aabb",
|
|
|
179 Mapping => Map_To_Lower_Case_Ptr) /= 2 or
|
|
|
180 BS80.Index(BS80.To_Bounded_String("WOULD MATCH BUT FOR THE CASE"),
|
|
|
181 "WOULD MATCH BUT FOR THE CASE",
|
|
|
182 Ada.Strings.Backward,
|
|
|
183 Map_To_Lower_Case_Ptr) /= 0
|
|
|
184 then
|
|
|
185 Report.Failed("Incorrect results from Function Index, using a " &
|
|
|
186 "Character Mapping Function parameter");
|
|
|
187 end if;
|
|
|
188
|
|
|
189
|
|
|
190 -- Function Index, Pattern_Error if Pattern = Null_String
|
|
|
191
|
|
|
192 declare
|
|
|
193 use BS20;
|
|
|
194 TC_Natural : Natural := 1000;
|
|
|
195 begin
|
|
|
196 TC_Natural := Index(To_Bounded_String("A Valid String"),
|
|
|
197 "",
|
|
|
198 Ada.Strings.Forward,
|
|
|
199 Map_To_Lower_Case_Ptr);
|
|
|
200 Report.Failed("Pattern_Error not raised by Function Index when " &
|
|
|
201 "given a null pattern string");
|
|
|
202 exception
|
|
|
203 when Pattern_Error => null; -- OK, expected exception.
|
|
|
204 when others =>
|
|
|
205 Report.Failed("Incorrect exception raised by Function Index " &
|
|
|
206 "using a Character_Mapping_Function parameter " &
|
|
|
207 "when given a null pattern string");
|
|
|
208 end;
|
|
|
209
|
|
|
210
|
|
|
211 -- Function Count.
|
|
|
212
|
|
|
213 if BS20.Count(BS20.To_Bounded_String("ABABABA"),
|
|
|
214 Pattern => "aba",
|
|
|
215 Mapping => Map_To_Lower_Case_Ptr) /= 2 or
|
|
|
216 BS20.Count(BS20.To_Bounded_String("ABABABA"),
|
|
|
217 "ABA",
|
|
|
218 Map_To_Lower_Case_Ptr) /= 0 or
|
|
|
219 BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
|
|
|
220 "is",
|
|
|
221 Map_To_Lower_Case_Ptr) /= 4 or
|
|
|
222 BS80.Count(BS80.To_Bounded_String("ABABABA"),
|
|
|
223 "ABA",
|
|
|
224 Map_To_Upper_Case_Ptr) /= 2 or
|
|
|
225 BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
|
|
|
226 "is",
|
|
|
227 Map_To_Upper_Case_Ptr) /= 0 or
|
|
|
228 BS80.Count(BS80.To_Bounded_String
|
|
|
229 ("Peter Piper and his Pickled Peppers"),
|
|
|
230 "p",
|
|
|
231 Map_To_Lower_Case_Ptr) /= 7 or
|
|
|
232 BS20.Count(BS20.To_Bounded_String("She sells sea shells"),
|
|
|
233 "s",
|
|
|
234 Map_To_Upper_Case_Ptr) /= 0 or
|
|
|
235 BS80.Count(BS80.To_Bounded_String("No matches what-so-ever"),
|
|
|
236 "matches",
|
|
|
237 Map_To_Upper_Case_Ptr) /= 0
|
|
|
238 then
|
|
|
239 Report.Failed("Incorrect results from Function Count, using " &
|
|
|
240 "a Character_Mapping_Function parameter");
|
|
|
241 end if;
|
|
|
242
|
|
|
243
|
|
|
244 -- Function Count, Pattern_Error if Pattern = Null_String
|
|
|
245
|
|
|
246 declare
|
|
|
247 use BS80;
|
|
|
248 TC_Natural : Natural := 1000;
|
|
|
249 begin
|
|
|
250 TC_Natural := Count(To_Bounded_String("A Valid String"),
|
|
|
251 "",
|
|
|
252 Map_To_Lower_Case_Ptr);
|
|
|
253 Report.Failed("Pattern_Error not raised by Function Count using " &
|
|
|
254 "a Character_Mapping_Function parameter when " &
|
|
|
255 "given a null pattern string");
|
|
|
256 exception
|
|
|
257 when Pattern_Error => null; -- OK, expected exception.
|
|
|
258 when others =>
|
|
|
259 Report.Failed("Incorrect exception raised by Function Count " &
|
|
|
260 "using a Character_Mapping_Function parameter " &
|
|
|
261 "when given a null pattern string");
|
|
|
262 end;
|
|
|
263
|
|
|
264
|
|
|
265 -- Function Translate.
|
|
|
266
|
|
|
267 if BS40.Translate(BS40.To_Bounded_String("A Mixed Case String"),
|
|
|
268 Mapping => Map_To_Lower_Case_Ptr) /=
|
|
|
269 BS40.To_Bounded_String("a mixed case string") or
|
|
|
270
|
|
|
271 BS20."/="(BS20.Translate(BS20.To_Bounded_String("ALL LOWER CASE"),
|
|
|
272 Map_To_Lower_Case_Ptr),
|
|
|
273 "all lower case") or
|
|
|
274
|
|
|
275 BS20."/="("end with lower case",
|
|
|
276 BS20.Translate(
|
|
|
277 BS20.To_Bounded_String("end with lower case"),
|
|
|
278 Map_To_Lower_Case_Ptr)) or
|
|
|
279
|
|
|
280 BS1.Translate(BS1.Null_Bounded_String,
|
|
|
281 Map_To_Lower_Case_Ptr) /=
|
|
|
282 BS1.Null_Bounded_String or
|
|
|
283
|
|
|
284 BS80."/="(BS80.Translate(BS80.To_Bounded_String
|
|
|
285 ("start with lower case, end with upper case"),
|
|
|
286 Map_To_Upper_Case_Ptr),
|
|
|
287 "START WITH LOWER CASE, END WITH UPPER CASE") or
|
|
|
288
|
|
|
289 BS40.Translate(BS40.To_Bounded_String("ALL UPPER CASE STRING"),
|
|
|
290 Map_To_Upper_Case_Ptr) /=
|
|
|
291 BS40.To_Bounded_String("ALL UPPER CASE STRING") or
|
|
|
292
|
|
|
293 BS80."/="(BS80.Translate(BS80.To_Bounded_String
|
|
|
294 ("LoTs Of MiXeD CaSe ChArAcTeRs In ThE StRiNg"),
|
|
|
295 Map_To_Upper_Case_Ptr),
|
|
|
296 "LOTS OF MIXED CASE CHARACTERS IN THE STRING")
|
|
|
297
|
|
|
298 then
|
|
|
299 Report.Failed("Incorrect results from Function Translate, using " &
|
|
|
300 "a Character_Mapping_Function parameter");
|
|
|
301 end if;
|
|
|
302
|
|
|
303
|
|
|
304 -- Procedure Translate.
|
|
|
305
|
|
|
306 BString_1 := BS1.To_Bounded_String("A");
|
|
|
307
|
|
|
308 BS1.Translate(Source => BString_1, Mapping => Map_To_Lower_Case_Ptr);
|
|
|
309
|
|
|
310 if not BS1."="(BString_1, "a") then -- "=" for Bounded_String, String
|
|
|
311 Report.Failed("Incorrect result from Procedure Translate - 1");
|
|
|
312 end if;
|
|
|
313
|
|
|
314 BString_20 := BS20.To_Bounded_String(String_20);
|
|
|
315 BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
|
|
|
316
|
|
|
317 if BString_20 /= BS20.To_Bounded_String("abcdefghijklmnopqrst") then
|
|
|
318 Report.Failed("Incorrect result from Procedure Translate - 2");
|
|
|
319 end if;
|
|
|
320
|
|
|
321 BString_40 := BS40.To_Bounded_String("String needing highlighting");
|
|
|
322 BS40.Translate(BString_40, Map_To_Upper_Case_Ptr);
|
|
|
323
|
|
|
324 if not (BString_40 = "STRING NEEDING HIGHLIGHTING") then
|
|
|
325 Report.Failed("Incorrect result from Procedure Translate - 3");
|
|
|
326 end if;
|
|
|
327
|
|
|
328 BString_80 := BS80.Null_Bounded_String;
|
|
|
329 BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
|
|
|
330
|
|
|
331 if not (BString_80 = BS80.Null_Bounded_String) then
|
|
|
332 Report.Failed("Incorrect result from Procedure Translate - 4");
|
|
|
333 end if;
|
|
|
334
|
|
|
335
|
|
|
336 exception
|
|
|
337 when others => Report.Failed ("Exception raised in Test_Block");
|
|
|
338 end Test_Block;
|
|
|
339
|
|
|
340 Report.Result;
|
|
|
341
|
|
|
342 end CXA4027;
|
