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

   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
  47 package 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;
  51 end CXA4029_0;
  52
  53 with Ada.Characters.Handling;
  54 package 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
  80 end CXA4029_0;
  81
  82
  83 with CXA4029_0;
  84 with Report;
  85 with Ada.Characters.Handling;
  86 with Ada.Characters.Latin_1;
  87 with Ada.Strings;
  88 with Ada.Strings.Wide_Maps;
  89 with Ada.Strings.Wide_Maps.Wide_Constants;
  90 with Ada.Strings.Wide_Fixed;
  91 with Ada.Strings.Wide_Bounded;
  92
  93 procedure CXA4029 is
  94 begin
  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
 333 end CXA4029;