gcc/testsuite/ada/acats/tests/cxa/cxa4030.a

   1 -- CXA4030.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 Ada.Strings.Unbounded versions of subprograms Translate
  28 --      (procedure and function), Index, and Count, which use a
  29 --      Maps.Character_Mapping_Function input parameter, produce correct
  30 --      results.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      This test examines the operation of the four subprograms contained
  34 --      in the Ada.Strings.Unbounded package that use a
  35 --      Character_Mapping_Function parameter to provide the mapping
  36 --      capability.
  37 --      Two Character_Mapping_Function objects are defined that reference
  38 --      subprograms contained in the Ada.Characters.Handling package;
  39 --      To_Lower will return the lower-case form of the character provided
  40 --      as the input parameter, To_Upper will return the upper-case form
  41 --      of the character input parameter (provided there is an upper-case
  42 --      form).
  43 --      In several instances in this test, the character handling functions
  44 --      are referenced directly in the parameter list of the subprograms
  45 --      under test, demonstrating another form of expected common usage.
  46 --
  47 --      Results of all subprograms are compared with expected results.
  48 --
  49 --      This test, when taken in conjunction with tests CXA4010, CXA4011,
  50 --      CXA4031, and CXA4032 will constitute a test of all the functionality
  51 --      contained in package Ada.Strings.Unbounded.  This test uses a variety
  52 --      of the subprograms defined in the unbounded string package in ways
  53 --      typical of common usage.
  54 --
  55 --
  56 -- CHANGE HISTORY:
  57 --      21 Feb 95   SAIC    Initial prerelease version
  58 --      21 Apr 95   SAIC    Modified header commentary.
  59 --
  60 --!
  61
  62 with Ada.Strings.Unbounded;
  63 with Ada.Strings.Maps;
  64 with Ada.Characters.Handling;
  65 with Ada.Characters.Latin_1;
  66 with Report;
  67
  68 procedure CXA4030 is
  69
  70 begin
  71
  72    Report.Test ("CXA4030", "Check that Ada.Strings.Unbounded versions " &
  73                            "of subprograms Translate (procedure and "   &
  74                            "function), Index, and Count, which use a "  &
  75                            "Maps.Character_Mapping_Function input "     &
  76                            "parameter, produce correct results");
  77
  78    Test_Block:
  79    declare
  80
  81       package Unb renames Ada.Strings.Unbounded;
  82       use type Unb.Unbounded_String;
  83       use Ada.Strings;
  84       use Ada.Characters;
  85
  86
  87       -- The following strings are used in examination of the Translation
  88       -- subprograms.
  89
  90       New_Character_String : Unb.Unbounded_String :=
  91                                Unb.To_Unbounded_String(
  92                                  Latin_1.LC_A_Grave          &
  93                                  Latin_1.LC_A_Ring           &
  94                                  Latin_1.LC_AE_Diphthong     &
  95                                  Latin_1.LC_C_Cedilla        &
  96                                  Latin_1.LC_E_Acute          &
  97                                  Latin_1.LC_I_Circumflex     &
  98                                  Latin_1.LC_Icelandic_Eth    &
  99                                  Latin_1.LC_N_Tilde          &
 100                                  Latin_1.LC_O_Oblique_Stroke &
 101                                  Latin_1.LC_Icelandic_Thorn);
 102
 103
 104       TC_New_Character_String : Unb.Unbounded_String :=
 105                                   Unb.To_Unbounded_String(
 106                                     Latin_1.UC_A_Grave          &
 107                                     Latin_1.UC_A_Ring           &
 108                                     Latin_1.UC_AE_Diphthong     &
 109                                     Latin_1.UC_C_Cedilla        &
 110                                     Latin_1.UC_E_Acute          &
 111                                     Latin_1.UC_I_Circumflex     &
 112                                     Latin_1.UC_Icelandic_Eth    &
 113                                     Latin_1.UC_N_Tilde          &
 114                                     Latin_1.UC_O_Oblique_Stroke &
 115                                     Latin_1.UC_Icelandic_Thorn);
 116
 117
 118       -- In this test, access objects are defined to refer to two functions
 119       -- from the Ada.Characters.Handling package.  These access objects
 120       -- will be provided as parameters to the subprograms under test.
 121       -- Note: There will be several examples in this test of these character
 122       --       handling functions being referenced directly within the
 123       --       parameter list of the subprograms under test.
 124
 125       Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
 126                                 Handling.To_Lower'Access;
 127
 128       Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
 129                                 Handling.To_Upper'Access;
 130
 131    begin
 132
 133       -- Function Index, Forward direction search.
 134       -- Note: Several of the following cases use the default value
 135       --       Forward for the Going parameter.
 136
 137       if Unb.Index(Source => Unb.To_Unbounded_String(
 138                                "The library package Strings.Unbounded"),
 139                    Pattern => "unb",
 140                    Going   => Ada.Strings.Forward,
 141                    Mapping => Map_To_Lower_Case_Ptr)    /= 29   or
 142
 143          Unb.Index(Unb.To_Unbounded_String(
 144                      "THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN"),
 145                    "ain",
 146                    Mapping => Map_To_Lower_Case_Ptr)    /= 6    or
 147
 148          Unb.Index(Unb.To_Unbounded_String("maximum number"),
 149                    "um",
 150                    Ada.Strings.Forward,
 151                    Handling.To_Lower'Access)            /= 6    or
 152
 153          Unb.Index(Unb.To_Unbounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),
 154                    "MIXED CASE STRING",
 155                    Ada.Strings.Forward,
 156                    Map_To_Upper_Case_Ptr)               /= 12   or
 157
 158          Unb.Index(Unb.To_Unbounded_String(
 159                      "STRING WITH NO MATCHING PATTERNS"),
 160                    "WITH",
 161                    Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
 162
 163          Unb.Index(Unb.To_Unbounded_String("THIS STRING IS IN UPPER CASE"),
 164                    "IS",
 165                    Ada.Strings.Forward,
 166                    Handling.To_Upper'Access)            /= 3    or
 167
 168          Unb.Index(Unb.Null_Unbounded_String,
 169                    "is",
 170                    Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
 171
 172          Unb.Index(Unb.To_Unbounded_String("AAABBBaaabbb"),
 173                    "aabb",
 174                    Mapping => Handling.To_Lower'Access) /= 2
 175       then
 176          Report.Failed("Incorrect results from Function Index, going "    &
 177                        "in Forward direction, using a Character Mapping " &
 178                        "Function parameter");
 179       end if;
 180
 181
 182
 183       -- Function Index, Backward direction search.
 184
 185       if Unb.Index(Unb.To_Unbounded_String("Case of a Mixed Case String"),
 186                    "case",
 187                    Ada.Strings.Backward,
 188                    Map_To_Lower_Case_Ptr)               /= 17   or
 189
 190          Unb.Index(Unb.To_Unbounded_String("Case of a Mixed Case String"),
 191                    "CASE",
 192                    Ada.Strings.Backward,
 193                    Mapping => Map_To_Upper_Case_Ptr)    /= 17   or
 194
 195          Unb.Index(Unb.To_Unbounded_String("rain, Rain, and more RAIN"),
 196                    "rain",
 197                    Ada.Strings.Backward,
 198                    Handling.To_Lower'Access)            /= 22   or
 199
 200          Unb.Index(Unb.To_Unbounded_String("RIGHT place, right time"),
 201                    "RIGHT",
 202                    Ada.Strings.Backward,
 203                    Handling.To_Upper'Access)            /= 14   or
 204
 205          Unb.Index(Unb.To_Unbounded_String("WOULD MATCH BUT FOR THE CASE"),
 206                    "WOULD MATCH BUT FOR THE CASE",
 207                    Going   => Ada.Strings.Backward,
 208                    Mapping => Map_To_Lower_Case_Ptr)    /= 0
 209       then
 210          Report.Failed("Incorrect results from Function Index, going "     &
 211                        "in Backward direction, using a Character Mapping " &
 212                        "Function parameter");
 213       end if;
 214
 215
 216
 217       -- Function Index, Pattern_Error if Pattern = Null_String
 218
 219       declare
 220          use Unbounded;
 221          Null_String : constant String := "";
 222          TC_Natural  : Natural         := 1000;
 223       begin
 224          TC_Natural := Index(To_Unbounded_String("A Valid Unbounded String"),
 225                              Null_String,
 226                              Going   => Ada.Strings.Forward,
 227                              Mapping => Handling.To_Lower'Access);
 228          Report.Failed("Pattern_Error not raised by Function Index when " &
 229                        "given a null pattern string");
 230       exception
 231          when Pattern_Error => null;   -- OK, expected exception.
 232          when others        =>
 233             Report.Failed("Incorrect exception raised by Function Index " &
 234                           "using a Character Mapping Function parameter " &
 235                           "when given a null pattern string");
 236       end;
 237
 238
 239
 240       -- Function Count.
 241
 242       if Unb.Count(Source  => Unb.To_Unbounded_String("ABABABA"),
 243                    Pattern => "aba",
 244                    Mapping => Map_To_Lower_Case_Ptr)   /=  2   or
 245
 246          Unb.Count(Unb.To_Unbounded_String("ABABABA"),
 247                    "ABA",
 248                    Mapping => Map_To_Lower_Case_Ptr)   /=  0   or
 249
 250          Unb.Count(Unb.To_Unbounded_String("This IS a MISmatched issue"),
 251                    "is",
 252                    Handling.To_Lower'Access)           /=  4   or
 253
 254          Unb.Count(Unb.To_Unbounded_String("ABABABA"),
 255                    "ABA",
 256                    Map_To_Upper_Case_Ptr)              /=  2   or
 257
 258          Unb.Count(Unb.To_Unbounded_String("This IS a MISmatched issue"),
 259                    "is",
 260                    Mapping => Map_To_Upper_Case_Ptr)   /=  0   or
 261
 262          Unb.Count(Unb.To_Unbounded_String(
 263                      "She sells sea shells by the sea shore"),
 264                    "s",
 265                    Handling.To_Lower'Access)           /=  8   or
 266
 267          Unb.Count(Unb.Null_Unbounded_String,
 268                    "match",
 269                    Map_To_Upper_Case_Ptr)              /=  0
 270       then
 271          Report.Failed("Incorrect results from Function Count, using " &
 272                        "a Character Mapping Function parameter");
 273       end if;
 274
 275
 276
 277       -- Function Count, Pattern_Error if Pattern = Null_String
 278
 279       declare
 280          use Ada.Strings.Unbounded;
 281          Null_Pattern_String : constant String := "";
 282          TC_Natural          : Natural         := 1000;
 283       begin
 284          TC_Natural := Count(To_Unbounded_String("A Valid String"),
 285                              Null_Pattern_String,
 286                              Map_To_Lower_Case_Ptr);
 287          Report.Failed("Pattern_Error not raised by Function Count using " &
 288                        "a Character Mapping Function parameter when "      &
 289                        "given a null pattern string");
 290       exception
 291          when Pattern_Error => null;   -- OK, expected exception.
 292          when others        =>
 293             Report.Failed("Incorrect exception raised by Function Count " &
 294                           "using a Character Mapping Function parameter " &
 295                           "when given a null pattern string");
 296       end;
 297
 298
 299
 300       -- Function Translate.
 301
 302       if Unb.Translate(Source  => Unb.To_Unbounded_String(
 303                                     "A Sample Mixed Case String"),
 304                        Mapping => Map_To_Lower_Case_Ptr)           /=
 305          Unb.To_Unbounded_String("a sample mixed case string")       or
 306
 307          Unb.Translate(Unb.To_Unbounded_String("ALL LOWER CASE"),
 308                        Handling.To_Lower'Access)                   /=
 309          Unb.To_Unbounded_String("all lower case")                   or
 310
 311          Unb.Translate(Unb.To_Unbounded_String("end with lower case"),
 312                        Map_To_Lower_Case_Ptr)                      /=
 313          Unb.To_Unbounded_String("end with lower case")              or
 314
 315          Unb.Translate(Unb.Null_Unbounded_String,
 316                        Handling.To_Lower'Access)                   /=
 317          Unb.Null_Unbounded_String                                   or
 318
 319          Unb.Translate(Unb.To_Unbounded_String("start with lower case"),
 320                        Map_To_Upper_Case_Ptr)                      /=
 321          Unb.To_Unbounded_String("START WITH LOWER CASE")            or
 322
 323          Unb.Translate(Unb.To_Unbounded_String("ALL UPPER CASE STRING"),
 324                        Handling.To_Upper'Access)                   /=
 325          Unb.To_Unbounded_String("ALL UPPER CASE STRING")            or
 326
 327          Unb.Translate(Unb.To_Unbounded_String(
 328                          "LoTs Of MiXeD CaSe ChArAcTeRs"),
 329                        Map_To_Upper_Case_Ptr)                      /=
 330          Unb.To_Unbounded_String("LOTS OF MIXED CASE CHARACTERS")    or
 331
 332          Unb.Translate(New_Character_String,
 333                        Handling.To_Upper'Access)                   /=
 334          TC_New_Character_String
 335
 336       then
 337          Report.Failed("Incorrect results from Function Translate, using " &
 338                        "a Character Mapping Function parameter");
 339       end if;
 340
 341
 342
 343       -- Procedure Translate.
 344
 345       declare
 346
 347          use Ada.Strings.Unbounded;
 348          use Ada.Characters.Handling;
 349
 350          Str_1    : Unbounded_String :=
 351                       To_Unbounded_String("AN ALL UPPER CASE STRING");
 352          Str_2    : Unbounded_String :=
 353                       To_Unbounded_String("A Mixed Case String");
 354          Str_3    : Unbounded_String :=
 355                       To_Unbounded_String("a string with lower case letters");
 356          TC_Str_1 : constant Unbounded_String := Str_1;
 357          TC_Str_3 : constant Unbounded_String := Str_3;
 358
 359       begin
 360
 361          Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);
 362
 363          if Str_1 /= To_Unbounded_String("an all upper case string") then
 364             Report.Failed("Incorrect result from Procedure Translate - 1");
 365          end if;
 366
 367          Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);
 368
 369          if Str_1 /= TC_Str_1 then
 370             Report.Failed("Incorrect result from Procedure Translate - 2");
 371          end if;
 372
 373          Translate(Str_2, Mapping => Map_To_Lower_Case_Ptr);
 374
 375          if Str_2 /= To_Unbounded_String("a mixed case string") then
 376             Report.Failed("Incorrect result from Procedure Translate - 3");
 377          end if;
 378
 379          Translate(Str_2, Mapping => To_Upper'Access);
 380
 381          if Str_2 /= To_Unbounded_String("A MIXED CASE STRING") then
 382             Report.Failed("Incorrect result from Procedure Translate - 4");
 383          end if;
 384
 385          Translate(Str_3, To_Lower'Access);
 386
 387          if Str_3 /= TC_Str_3 then
 388             Report.Failed("Incorrect result from Procedure Translate - 5");
 389          end if;
 390
 391          Translate(Str_3, To_Upper'Access);
 392
 393          if Str_3 /=
 394             To_Unbounded_String("A STRING WITH LOWER CASE LETTERS")
 395          then
 396             Report.Failed("Incorrect result from Procedure Translate - 6");
 397          end if;
 398
 399          Translate(New_Character_String, Map_To_Upper_Case_Ptr);
 400
 401          if New_Character_String /= TC_New_Character_String then
 402             Report.Failed("Incorrect result from Procedure Translate - 6");
 403          end if;
 404
 405       end;
 406
 407
 408    exception
 409       when others => Report.Failed ("Exception raised in Test_Block");
 410    end Test_Block;
 411
 412    Report.Result;
 413
 414 end CXA4030;