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
68with Ada.Characters.Handling;
69function CXA4027_0 (From : Character) return Character;
70
71function CXA4027_0 (From : Character) return Character is
72begin
73   return Ada.Characters.Handling.To_Lower(From);
74end 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
83with Ada.Characters.Handling;
84function CXA4027_1 (From : Character) return Character;
85
86function CXA4027_1 (From : Character) return Character is
87begin
88   return Ada.Characters.Handling.To_Upper(From);
89end CXA4027_1;
90
91
92with CXA4027_0, CXA4027_1;
93with Ada.Strings.Bounded;
94with Ada.Strings.Maps;
95with Ada.Characters.Handling;
96with Report;
97
98procedure CXA4027 is
99begin
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
342end CXA4027;
343