1-- CXA4029.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 functionality found in packages Ada.Strings.Wide_Maps,
28--      Ada.Strings.Wide_Bounded, and Ada.Strings.Wide_Maps.Wide_Constants
29--      is available and produces correct results.
30--
31-- TEST DESCRIPTION:
32--      This test tests the subprograms found in the
33--      Ada.Strings.Wide_Bounded package.  It is based on the tests
34--      CXA4027-28, which are tests for the complementary "non-wide"
35--      packages.
36--
37--      The functions found in CXA4029_0 provide mapping capability, when
38--      used in conjunction with Wide_Character_Mapping_Function objects.
39--
40--
41-- CHANGE HISTORY:
42--      23 Jun 95   SAIC    Initial prerelease version.
43--      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
44--
45--!
46
47package CXA4029_0 is
48   -- Functions used to supply mapping capability.
49   function Map_To_Lower_Case (From : Wide_Character) return Wide_Character;
50   function Map_To_Upper_Case (From : Wide_Character) return Wide_Character;
51end CXA4029_0;
52
53with Ada.Characters.Handling;
54package body CXA4029_0 is
55      -- Function Map_To_Lower_Case will return the lower case form of
56      -- Wide_Characters in the range 'A'..'Z' only, and return the input
57      -- wide_character otherwise.
58
59      function Map_To_Lower_Case (From : Wide_Character)
60         return Wide_Character is
61      begin
62         return Ada.Characters.Handling.To_Wide_Character(
63                  Ada.Characters.Handling.To_Lower(
64                    Ada.Characters.Handling.To_Character(From)));
65      end Map_To_Lower_Case;
66
67      -- Function Map_To_Upper_Case will return the upper case form of
68      -- Wide_Characters in the range 'a'..'z', or whose position is in one
69      -- of the ranges 223..246 or 248..255, provided the wide_character has
70      -- an upper case form.
71
72      function Map_To_Upper_Case (From : Wide_Character)
73        return Wide_Character is
74      begin
75         return Ada.Characters.Handling.To_Wide_Character(
76                  Ada.Characters.Handling.To_Upper(
77                    Ada.Characters.Handling.To_Character(From)));
78      end Map_To_Upper_Case;
79
80end CXA4029_0;
81
82
83with CXA4029_0;
84with Report;
85with Ada.Characters.Handling;
86with Ada.Characters.Latin_1;
87with Ada.Strings;
88with Ada.Strings.Wide_Maps;
89with Ada.Strings.Wide_Maps.Wide_Constants;
90with Ada.Strings.Wide_Fixed;
91with Ada.Strings.Wide_Bounded;
92
93procedure CXA4029 is
94begin
95   Report.Test ("CXA4029",
96                "Check that subprograms defined in package " &
97                "Ada.Strings.Wide_Bounded produce correct results");
98
99   Test_Block:
100   declare
101
102      package ACL1 renames Ada.Characters.Latin_1;
103      package BS1  is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(1);
104      package BS20 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(20);
105      package BS40 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(40);
106      package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80);
107
108      subtype LC_Characters is Wide_Character range 'a'..'z';
109
110      use Ada.Characters, Ada.Strings;
111      use type Wide_Maps.Wide_Character_Set;
112      use type BS1.Bounded_Wide_String,  BS20.Bounded_Wide_String,
113               BS40.Bounded_Wide_String, BS80.Bounded_Wide_String;
114
115      TC_String      : constant Wide_String := "A Standard String";
116
117      BString_1      : BS1.Bounded_Wide_String  :=
118                              BS1.Null_Bounded_Wide_String;
119      BString_20     : BS20.Bounded_Wide_String :=
120                              BS20.Null_Bounded_Wide_String;
121      BString_40     : BS40.Bounded_Wide_String :=
122                              BS40.Null_Bounded_Wide_String;
123      BString_80     : BS80.Bounded_Wide_String :=
124                              BS80.Null_Bounded_Wide_String;
125      String_20      : Wide_String(1..20)    := "ABCDEFGHIJKLMNOPQRST";
126      String_40      : Wide_String(1..40)    := "abcdefghijklmnopqrst" &
127                                                String_20;
128      String_80      : Wide_String(1..80)    := String_40 & String_40;
129      TC_String_5    : Wide_String(1..5)     := "ABCDE";
130
131      -- The following strings are used in examination of the Translation
132      -- subprograms.
133      New_Character_String : Wide_String(1..10) :=
134        Handling.To_Wide_String(
135          ACL1.LC_A_Grave          & ACL1.LC_A_Ring  & ACL1.LC_AE_Diphthong &
136          ACL1.LC_C_Cedilla        & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex &
137          ACL1.LC_Icelandic_Eth    & ACL1.LC_N_Tilde &
138          ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn);
139
140      TC_New_Character_String : Wide_String(1..10) :=
141        Handling.To_Wide_String(
142          ACL1.UC_A_Grave          & ACL1.UC_A_Ring  & ACL1.UC_AE_Diphthong &
143          ACL1.UC_C_Cedilla        & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex &
144          ACL1.UC_Icelandic_Eth    & ACL1.UC_N_Tilde &
145          ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn);
146
147      -- Access objects that will be provided as parameters to the
148      -- subprograms.
149      Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
150                                CXA4029_0.Map_To_Lower_Case'Access;
151      Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
152                                CXA4029_0.Map_To_Upper_Case'Access;
153
154   begin
155
156      -- Testing of functionality found in Package Ada.Strings.Wide_Bounded.
157      --
158      -- Function Index.
159
160      if BS80.Index(BS80.To_Bounded_Wide_String("CoMpLeTeLy MiXeD CaSe"),
161                    "MIXED CASE",
162                    Ada.Strings.Forward,
163                    Map_To_Upper_Case_Ptr)                /= 12  or
164         BS1.Index(BS1.Null_Bounded_Wide_String,
165                   "i",
166                   Mapping => Map_To_Lower_Case_Ptr)      /= 0
167      then
168         Report.Failed("Incorrect results from BND Function Index, going " &
169                       "in Forward direction, using a Character Mapping "  &
170                       "Function parameter");
171      end if;
172
173      -- Function Count.
174      if BS40.Count(BS40.To_Bounded_Wide_String("This IS a MISmatched issue"),
175                    "is",
176                    Map_To_Lower_Case_Ptr)                   /=  4   or
177         BS80.Count(BS80.To_Bounded_Wide_String("ABABABA"),
178                    "ABA",
179                    Map_To_Upper_Case_Ptr)                   /=  2
180      then
181         Report.Failed("Incorrect results from BND Function Count, using " &
182                       "a Character_Mapping_Function parameter");
183      end if;
184
185      -- Function Translate.
186      if BS40.Translate(BS40.To_Bounded_Wide_String("A Mixed Case String"),
187                        Mapping => Map_To_Lower_Case_Ptr)   /=
188         BS40.To_Bounded_Wide_String("a mixed case string")   or
189         BS20."/="("end with lower case",
190                   BS20.Translate(
191                     BS20.To_Bounded_Wide_String("end with lower case"),
192                     Map_To_Lower_Case_Ptr))
193      then
194         Report.Failed("Incorrect results from BND Function Translate, " &
195                       "using a Character_Mapping_Function parameter");
196      end if;
197
198      -- Procedure Translate.
199      BString_20 := BS20.To_Bounded_Wide_String(String_20);
200      BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
201      if BString_20 /= BS20.To_Bounded_Wide_String("abcdefghijklmnopqrst")
202      then
203         Report.Failed("Incorrect result from BND Procedure Translate - 1");
204      end if;
205
206      BString_80 := BS80.Null_Bounded_Wide_String;
207      BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
208      if not (BString_80 = BS80.Null_Bounded_Wide_String) then
209         Report.Failed("Incorrect result from BND Procedure Translate - 2");
210      end if;
211
212      -- Procedure Append.
213      declare
214         use BS20;
215      begin
216         BString_20 := BS20.Null_Bounded_Wide_String;
217         Append(BString_20, 'T');
218         Append(BString_20, "his string");
219         Append(BString_20,
220                To_Bounded_Wide_String(" is complete."),
221                Drop => Ada.Strings.Right);            -- Drop 4 characters.
222         if BString_20 /= To_Bounded_Wide_String("This string is compl") then
223            Report.Failed("Incorrect results from BS20 versions of " &
224                          "procedure Append");
225         end if;
226      exception
227         when others => Report.Failed("Exception raised in block checking " &
228                                      "BND Procedure Append");
229      end;
230
231      -- Operator "=".
232      BString_40 := BS40.To_Bounded_Wide_String(String_40);
233      BString_80 := BS80.To_Bounded_Wide_String(
234                           BS40.To_Wide_String(BString_40) &
235                           BS40.To_Wide_String(BString_40));
236      if not (BString_40 = String_40 and
237              BS80."="(String_80, BString_80)) then
238         Report.Failed("Incorrect results from BND Function ""="" with " &
239                       "string - bounded string parameter combinations");
240      end if;
241
242      -- Operator "<".
243      BString_1  := BS1.To_Bounded_Wide_String("cat",
244                                               Drop => Ada.Strings.Right);
245      BString_20 := BS20.To_Bounded_Wide_String("Santa Claus");
246      if BString_1 < "C"                or
247         BS1."<"(BString_1,"c")         or
248         BS1."<"("x", BString_1)        or
249         BS20."<"(BString_20,"Santa ")  or
250         BS20."<"("Santa and his Elves", BString_20)
251      then
252         Report.Failed("Incorrect results from BND Function ""<"" with " &
253                       "string - bounded string parameter combinations");
254      end if;
255
256      -- Operator "<=".
257      BString_20 := BS20.To_Bounded_Wide_String("Sample string");
258      if BS20."<="(BString_20,"Sample strin")  or
259         not(BS20."<="("Sample string",BString_20))
260      then
261         Report.Failed("Incorrect results from BND Function ""<="" with " &
262                       "string - bounded string parameter combinations");
263      end if;
264
265      -- Operator ">".
266      BString_40 := BS40.To_Bounded_Wide_String(
267                           "A MUCH LONGER SAMPLE STRING.");
268      if BString_40 > "A much longer sample string"          or
269         BS40.To_Bounded_Wide_String("ABCDEFGH") > "abcdefgh"
270      then
271         Report.Failed("Incorrect results from BND Function "">"" with " &
272                       "string - bounded string parameter combinations");
273      end if;
274
275      -- Operator ">=".
276      BString_80 := BS80.To_Bounded_Wide_String(String_80);
277      if not (BString_80 >= String_80  and
278              BS80.To_Bounded_Wide_String("Programming") >= "PROGRAMMING" and
279              BS80.">="("test", BS80.To_Bounded_Wide_String("tess")))
280      then
281         Report.Failed("Incorrect results from BND Function "">="" with " &
282                       "string - bounded string parameter combinations");
283      end if;
284
285      -- Procedure Trim
286      BString_20 := BS20.To_Bounded_Wide_String("   Both Sides      ");
287      BS20.Trim(BString_20, Ada.Strings.Both);
288      if BString_20 /= BS20.To_Bounded_Wide_String("Both Sides") then
289         Report.Failed("Incorrect results from BND Procedure Trim with " &
290                       "Side = Both");
291      end if;
292
293      -- Procedure Head
294      BString_40 := BS40.To_Bounded_Wide_String("Test String");
295      BS40.Head(Source => BString_40,
296                Count  => 4);                       -- Count < Source'Length
297      if BString_40 /= BS40.To_Bounded_Wide_String("Test") then
298         Report.Failed("Incorrect results from BND Procedure Head with " &
299                       "the Count parameter less than Source'Length");
300      end if;
301
302      BString_20 := BS20.To_Bounded_Wide_String("Short String");
303      BS20.Head(BString_20, 23, '-', Ada.Strings.Right);
304      if BS20.To_Bounded_Wide_String("Short String--------") /= BString_20 then
305         Report.Failed("Incorrect results from BND Procedure Head with "  &
306                       "the Count parameter greater than Source'Length, " &
307                       "and the Drop parameter = Right");
308      end if;
309
310      -- Procedure Tail
311      BString_40 := BS40.To_Bounded_Wide_String("Test String");
312      BS40.Tail(Source => BString_40,
313                Count  => 6);
314      if BString_40 /= BS40.To_Bounded_Wide_String("String") then
315         Report.Failed("Incorrect results from BND Procedure Tail with " &
316                       "the Count parameter less than Source'Length");
317      end if;
318
319      BString_20 := BS20.To_Bounded_Wide_String("Maximum Length Chars");
320      BS20.Tail(BString_20, 23, '-', Ada.Strings.Right);
321      if BS20.To_Bounded_Wide_String("---Maximum Length Ch") /= BString_20 then
322         Report.Failed("Incorrect results from BND Procedure Tail with "  &
323                       "the Count parameter greater than Source'Length, " &
324                       "and the Drop parameter = Right");
325      end if;
326
327   exception
328      when others => Report.Failed ("Exception raised in Test_Block");
329   end Test_Block;
330
331   Report.Result;
332
333end CXA4029;
334