1-- CXA4018.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
28--      Ada.Strings.Wide_Bounded are available, and that they produce
29--      correct results. Specifically, check the subprograms Append,
30--      Count, Element, Find_Token, Head, Index_Non_Blank, Replace_Element,
31--      Replicate, Tail, To_Bounded_Wide_String, "&", ">", "<", ">=", "<=",
32--      and "*".
33--
34-- TEST DESCRIPTION:
35--      This test, when taken in conjunction with test CXA40[17,19,20], will
36--      constitute a test of all the functionality contained in package
37--      Ada.Strings.Wide_Bounded.  This test uses a variety of the
38--      subprograms defined in the wide bounded string package in ways typical
39--      of common usage.  Different combinations of available subprograms
40--      are used to accomplish similar wide bounded string processing goals.
41--
42--
43-- CHANGE HISTORY:
44--      06 Dec 94   SAIC    ACVC 2.0
45--      22 Dec 94   SAIC    Changed obsolete constant to Strings.Wide_Space.
46--      06 Nov 95   SAIC    Corrected evaluation string used in Head/Tail
47--                          subtests for ACVC 2.0.1.
48--
49--!
50
51with Ada.Strings;
52with Ada.Strings.Wide_Bounded;
53with Ada.Characters.Handling;
54with Ada.Strings.Wide_Maps;
55with Report;
56
57procedure CXA4018 is
58
59   -- The following two functions are used to translate character and string
60   -- values to "Wide" values.  They will be applied to all the Wide_Bounded
61   -- subprogram parameters to simulate the use of Wide_Characters and
62   -- Wide_Strings in actual practice. Blanks are translated to Wide_Character
63   -- blanks and all other characters are translated into Wide_Characters with
64   -- position values 256 greater than their (narrow) character position
65   -- values.
66
67   function Translate (Ch : Character) return Wide_Character is
68      C : Character := Ch;
69   begin
70      if Ch = ' ' then
71         return Ada.Characters.Handling.To_Wide_Character(C);
72      else
73         return Wide_Character'Val(Character'Pos(Ch) +
74                                   Character'Pos(Character'Last) + 1);
75      end if;
76   end Translate;
77
78   function Translate (Str : String) return Wide_String is
79      WS : Wide_String(Str'First..Str'Last);
80   begin
81      for i in Str'First..Str'Last loop
82         WS(i) := Translate(Str(i));
83      end loop;
84      return WS;
85   end Translate;
86
87
88begin
89
90   Report.Test ("CXA4018", "Check that the subprograms defined in package " &
91                           "Ada.Strings.Wide_Bounded are available, and "   &
92                           "that they produce correct results");
93
94   Test_Block:
95   declare
96
97      package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80);
98      use type BS80.Bounded_Wide_String;
99
100      Part1 : constant Wide_String     := Translate("Rum");
101      Part2 : Wide_Character           := Translate('p');
102      Part3 : BS80.Bounded_Wide_String :=
103                BS80.To_Bounded_Wide_String(Translate("el"));
104      Part4 : Wide_Character           := Translate('s');
105      Part5 : BS80.Bounded_Wide_String :=
106                BS80.To_Bounded_Wide_String(Translate("tilt"));
107      Part6 : Wide_String(1..3)        := Translate("ski");
108
109      Full_Catenate_String,
110      Full_Append_String,
111      Constructed_String,
112      Drop_String,
113      Replicated_String,
114      Token_String         : BS80.Bounded_Wide_String;
115
116      CharA : Wide_Character := Translate('A');
117      CharB : Wide_Character := Translate('B');
118      CharC : Wide_Character := Translate('C');
119      CharD : Wide_Character := Translate('D');
120      CharE : Wide_Character := Translate('E');
121      CharF : Wide_Character := Translate('F');
122
123      ABStr : Wide_String(1..15) := Translate("AAAAABBBBBBBBBB");
124      StrB  : Wide_String(1..2)  := Translate("BB");
125      StrE  : Wide_String(1..2)  := Translate("EE");
126
127
128   begin
129
130      -- Evaluation of the overloaded forms of the "&" operator.
131
132      Full_Catenate_String :=
133        BS80."&"(Part2,                            -- WChar & Bnd WStr
134                 BS80."&"(Part3,                   -- Bnd WStr & Bnd WStr
135                          BS80."&"(Part4,          -- WChar & Bnd WStr
136                                   BS80."&"(Part5, -- Bnd WStr & Bnd WStr
137                                            BS80.To_Bounded_Wide_String
138                                              (Part6)))));
139
140      Full_Catenate_String :=
141        BS80."&"(Part1, Full_Catenate_String);     -- WStr & Bnd WStr
142      Full_Catenate_String :=
143        BS80."&"(Left  => Full_Catenate_String,
144                 Right => Translate('n'));         -- Bnd WStr & WChar
145
146
147      -- Evaluation of the overloaded forms of function Append.
148
149      Full_Append_String :=
150        BS80.Append(Part2,                               -- WChar,Bnd WStr
151          BS80.Append(Part3,                             -- Bnd WStr, Bnd WStr
152            BS80.Append(Part4,                           -- WChar,Bnd WStr
153              BS80.Append(BS80.To_Wide_String(Part5),    -- WStr,Bnd WStr
154                BS80.To_Bounded_Wide_String(Part6)))));
155
156      Full_Append_String :=
157        BS80.Append(BS80.To_Bounded_Wide_String(Part1),  -- Bnd WStr, WStr
158                    BS80.To_Wide_String(Full_Append_String));
159
160      Full_Append_String :=
161        BS80.Append(Left  => Full_Append_String,
162                    Right => Translate('n'));             -- Bnd WStr, WChar
163
164
165      -- Validate the resulting bounded wide strings.
166
167      if BS80."<"(Full_Catenate_String, Full_Append_String) or
168         BS80.">"(Full_Catenate_String, Full_Append_String) or
169         not (Full_Catenate_String  = Full_Append_String and
170              BS80."<="(Full_Catenate_String, Full_Append_String) and
171              BS80.">="(Full_Catenate_String, Full_Append_String))
172      then
173         Report.Failed
174           ("Incorrect results from bounded wide string catenation" &
175            " and comparison");
176      end if;
177
178
179      -- Evaluate the overloaded forms of the Constructor function "*" and
180      -- the Replicate function.
181
182      Constructed_String :=
183        BS80."*"(2,CharA) &                     -- "AA"
184        BS80."*"(2,StrB) &                      -- "AABBBB"
185        BS80."*"(3, BS80."*"(2, CharC)) &       -- "AABBBBCCCCCC"
186        BS80.Replicate(3,
187                   BS80.Replicate(2, CharD)) &  -- "AABBBBCCCCCCDDDDDD"
188        BS80.Replicate(2, StrE) &               -- "AABBBBCCCCCCDDDDDDEEEE"
189        BS80.Replicate(2, CharF);               -- "AABBBBCCCCCCDDDDDDEEEEFF"
190
191
192      -- Use of Function Replicate that involves dropping wide characters.
193      -- The attempt to replicate the 15 character wide string six times will
194      -- exceed the 80 wide character bound of the wide string.  Therefore,
195      -- the result should be the catenation of 5 copies of the 15 character
196      -- wide string, followed by 5 'A' wide characters (the first five wide
197      -- characters of the 6th replication) with the remaining wide
198      -- characters of the 6th replication dropped.
199
200      Drop_String :=
201         BS80.Replicate(Count => 6,
202                        Item  => ABStr,              -- "AAAAABBBBBBBBBB"
203                        Drop  => Ada.Strings.Right);
204
205      if BS80.Element(Drop_String, 1)  /= Translate('A') or
206         BS80.Element(Drop_String, 6)  /= Translate('B') or
207         BS80.Element(Drop_String, 76) /= Translate('A') or
208         BS80.Element(Drop_String, 80) /= Translate('A')
209      then
210         Report.Failed("Incorrect result from Replicate with Drop");
211      end if;
212
213
214      -- Use function Index_Non_Blank in the evaluation of the
215      -- Constructed_String.
216
217      if BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Forward)  /=
218         BS80.To_Wide_String(Constructed_String)'First                    or
219         BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Backward) /=
220         BS80.Length(Constructed_String)
221      then
222         Report.Failed("Incorrect results from constructor functions");
223      end if;
224
225
226
227      declare
228
229         -- Define wide character set objects for use with the Count function.
230         -- Constructed_String = "AABBBBCCCCCCDDDDDDEEEEFF" from above.
231
232         A_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
233                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
234                                                           1));
235         B_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
236                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
237                                                           3));
238         C_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
239                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
240                                                           7));
241         D_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
242                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
243                                                           13));
244         E_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
245                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
246                                                           19));
247         F_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
248                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
249                                                           23));
250         Start : Positive;
251         Stop  : Natural  := 0;
252
253      begin
254
255         -- Evaluate the results from function Count by comparing the number
256         -- of A's to the number of F's, B's to E's, and C's to D's in the
257         -- Constructed_String.
258         -- There should be an equal number of each of the wide characters that
259         -- are being compared (i.e., 2 A's and F's, 4 B's and E's, etc)
260
261         if BS80.Count(Constructed_String, A_Set)      /=
262            BS80.Count(Constructed_String, F_Set)        or
263            BS80.Count(Constructed_String, B_Set)      /=
264            BS80.Count(Constructed_String, E_Set)        or
265            not (BS80.Count(Constructed_String, C_Set)  =
266                 BS80.Count(Constructed_String, D_Set))
267         then
268            Report.Failed("Incorrect result from function Count");
269         end if;
270
271
272         -- Evaluate the functions Head, Tail, and Find_Token.
273         -- Create the Token_String from the Constructed_String above.
274
275         Token_String :=
276           BS80.Tail(BS80.Head(Constructed_String,  3), 2) &     -- "AB" &
277           BS80.Head(BS80.Tail(Constructed_String, 13), 2) &     -- "CD" &
278           BS80.Head(BS80.Tail(Constructed_String,  3), 2);      -- "EF"
279
280         if Token_String /=
281            BS80.To_Bounded_Wide_String(Translate("ABCDEF")) then
282            Report.Failed("Incorrect result from Catenation of Token_String");
283         end if;
284
285
286         -- Find the starting/ending position of the first A in the
287         -- Token_String (both should be 1, only one A appears in string).
288         -- The Function Head uses the default pad character to return a
289         -- bounded wide string longer than its input parameter bounded
290         -- wide string.
291
292         BS80.Find_Token(BS80.Head(Token_String, 10),  -- Default pad.
293                         A_Set,
294                         Ada.Strings.Inside,
295                         Start,
296                         Stop);
297
298         if Start /= 1 and Stop /= 1 then
299            Report.Failed("Incorrect result from Find_Token - 1");
300         end if;
301
302
303         -- Find the starting/ending position of the first non-AB slice in
304         -- the "head" five wide characters of Token_String (slice CDE at
305         -- positions 3-5)
306
307         BS80.Find_Token(BS80.Head(Token_String, 5),               -- "ABCDE"
308                         Ada.Strings.Wide_Maps."OR"(A_Set, B_Set), -- Set (AB)
309                         Ada.Strings.Outside,
310                         Start,
311                         Stop);
312
313         if Start /= 3 and Stop /= 5 then
314            Report.Failed("Incorrect result from Find_Token - 2");
315         end if;
316
317
318         -- Find the starting/ending position of the first CD slice in
319         -- the "tail" eight wide characters (including two pad wide
320         -- characters) of Token_String (slice CD at positions 5-6 of
321         -- the tail portion specified)
322
323         BS80.Find_Token(BS80.Tail(Token_String, 8,
324                                   Ada.Strings.Wide_Space),
325                         Ada.Strings.Wide_Maps."OR"(C_Set, D_Set),
326                         Ada.Strings.Inside,
327                         Start,
328                         Stop);
329
330         if Start /= 5 and Stop /= 6 then
331            Report.Failed("Incorrect result from Find_Token - 3");
332         end if;
333
334
335         -- Evaluate the Replace_Element function.
336
337         -- Token_String = "ABCDEF"
338
339         BS80.Replace_Element(Token_String, 3, BS80.Element(Token_String,4));
340
341         -- Token_String = "ABDDEF"
342
343         BS80.Replace_Element(Source => Token_String,
344                              Index  => 2,
345                              By     => BS80.Element(Token_String, 5));
346
347         -- Token_String = "AEDDEF"
348
349         BS80.Replace_Element(Token_String,
350                              1,
351                              BS80.Element(BS80.Tail(Token_String, 2), 2));
352
353         -- Token_String = "FEDDEF"
354         -- Evaluate this result.
355
356         if BS80.Element(Token_String,
357                         BS80.To_Wide_String(Token_String)'First)  /=
358            BS80.Element(Token_String,
359                         BS80.To_Wide_String(Token_String)'Last)     or
360            BS80.Count(Token_String, D_Set)                        /=
361            BS80.Count(Token_String, E_Set)                          or
362            BS80.Index_Non_Blank(BS80.Head(Token_String,6))        /=
363            BS80.Index_Non_Blank(BS80.Tail(Token_String,6))          or
364            BS80.Head(Token_String, 1)                             /=
365            BS80.Tail(Token_String, 1)
366         then
367            Report.Failed("Incorrect result from operations in combination");
368         end if;
369
370      end;
371
372   exception
373      when others => Report.Failed ("Exception raised in Test_Block");
374   end Test_Block;
375
376
377   Report.Result;
378
379end CXA4018;
380