gomp-20050608-branch/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a

   1 -- CXA3003.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 functions defined in package Ada.Characters.Handling
  28 --      for use in classifying and converting characters between the ISO 646
  29 --      and type Character sets produce the correct results with both
  30 --      Character and String input values.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      This test is designed to exercise the classification and conversion
  34 --      functions (between Character and ISO_646 types) found in package
  35 --      Ada.Characters.Handling.  Two subprograms are defined, a procedure for
  36 --      characters, a function for strings, that will utilize these functions
  37 --      to validate and change characters in variables.  In the procedure, if
  38 --      a character argument is found to be outside the subtype ISO_646, this
  39 --      character is evaluated to determine whether it is also a letter.
  40 --      If it is a letter, the character is converted to a basic character and
  41 --      returned.  If it is not a letter, the character is exchanged with an
  42 --      asterisk.  In the case of the function subprogram designed for strings,
  43 --      if a character component of a string argument is outside the subtype
  44 --      ISO_646, that character is substituted with an asterisk.
  45 --
  46 --      Arguments for the defined subprograms consist of ISO_646 characters,
  47 --      non-ISO_646 characters, strings with only ISO_646 characters, and
  48 --      strings with non-ISO_646 characters. The character and string values
  49 --      are then validated to determine that the expected results were
  50 --      obtained.
  51 --
  52 --
  53 -- CHANGE HISTORY:
  54 --      06 Dec 94   SAIC    ACVC 2.0
  55 --      29 Apr 95   SAIC    Modified identifier string lengths.
  56 --      31 Oct 95   SAIC    Update and repair for ACVC 2.0.1.
  57 --
  58 --!
  59
  60 with Ada.Characters.Latin_1;
  61 with Ada.Characters.Handling;
  62 with Report;
  63
  64 procedure CXA3003 is
  65
  66 begin
  67
  68    Report.Test ("CXA3003", "Check that the functions defined in package " &
  69                            "Ada.Characters.Handling for use in "          &
  70                            "classifying and converting characters "       &
  71                            "between the ISO 646 and type Character sets " &
  72                            "produce the correct results with both "       &
  73                            "Character and String input values" );
  74
  75    Test_Block:
  76    declare
  77
  78       -- ISO_646 Characters
  79
  80       Char_1,
  81       TC_Char_1  : Character := Ada.Characters.Latin_1.NUL;    -- Control Char
  82       Char_2,
  83       TC_Char_2  : Character := Ada.Characters.Latin_1.Colon;  -- Graphic Char
  84       Char_3,
  85       TC_Char_3  : Character := '4';
  86       Char_4,
  87       TC_Char_4  : Character := 'Z';
  88       Char_5,
  89       TC_Char_5  : Character := Ada.Characters.Latin_1.LC_W;   -- w
  90
  91       New_ISO_646_Char : Character := '*';
  92
  93
  94       -- Non-ISO_646 Characters
  95
  96       Char_Array : array (6..10) of Character :=
  97                                        (Ada.Characters.Latin_1.SSA,
  98                                         Ada.Characters.Latin_1.Cent_Sign,
  99                                         Ada.Characters.Latin_1.Cedilla,
 100                                         Ada.Characters.Latin_1.UC_A_Ring,
 101                                         Ada.Characters.Latin_1.LC_A_Ring);
 102
 103       TC_Char : constant Character := '*';
 104
 105       -- ISO_646 Strings
 106
 107       Str_1,
 108       TC_Str_1 : String (1..5) := "ABCDE";
 109
 110       Str_2,
 111       TC_Str_2 : String (1..5) := "#$%^&";
 112
 113
 114       -- Non-ISO_646 Strings
 115
 116       Str_3    : String (1..8) := "$123.45" &
 117                                   Ada.Characters.Latin_1.Cent_Sign;
 118       TC_Str_3 : String (1..8) := "$123.45*";
 119
 120       Str_4    : String (1..7) := "abc" &
 121                                   Ada.Characters.Latin_1.Cedilla &
 122                                   "efg";
 123       TC_Str_4 : String (1..7) := "abc*efg";
 124
 125       Str_5    : String (1..3) := Ada.Characters.Latin_1.LC_E_Grave &
 126                                   Ada.Characters.Latin_1.LC_T       &
 127                                   Ada.Characters.Latin_1.LC_E_Acute;
 128       TC_Str_5 : String (1..3) := "*t*";
 129
 130       ---
 131
 132       procedure Validate_Character (Char : in out Character) is
 133          -- If parameter Char is an ISO_646 character, Char will be returned,
 134          -- otherwise the following constant will be returned.
 135          Star : constant Ada.Characters.Handling.ISO_646 :=
 136            Ada.Characters.Latin_1.Asterisk;
 137       begin
 138          if Ada.Characters.Handling.Is_ISO_646(Char) then
 139             -- Check that the Is_ISO_646 function provide a correct result.
 140             if Character'Pos(Char) > 127 then
 141                Report.Failed("Is_ISO_646 returns a false positive result");
 142             end if;
 143          else
 144             if Character'Pos(Char) < 128 then
 145                Report.Failed("Is_ISO_646 returns a false negative result");
 146             end if;
 147          end if;
 148          -- Cross-check Is_ISO_646 with To_ISO_646.  '*' will be returned
 149          -- if Char is not in the ISO_646 set.
 150          Char := Ada.Characters.Handling.To_ISO_646(Char, Star);
 151       exception
 152          when others => Report.Failed ("Exception in Validate_Character");
 153       end Validate_Character;
 154
 155       ---
 156
 157       function Validate_String (Str : String) return String is
 158          New_ISO_646_Char : constant Ada.Characters.Handling.ISO_646 :=
 159            Ada.Characters.Latin_1.Asterisk;
 160       begin
 161          -- Checking that the string contains non-ISO_646 characters at this
 162          -- point is not strictly necessary, since the function To_ISO_646
 163          -- will perform that check as part of its processing, and would
 164          -- return the original string if no modification were necessary.
 165          -- However, this format allows for the testing of both functions.
 166
 167          if not Ada.Characters.Handling.Is_ISO_646(Str) then
 168             return Ada.Characters.Handling.To_ISO_646
 169                      (Item => Str, Substitute => New_ISO_646_Char);
 170          else
 171             return Str;
 172          end if;
 173       exception
 174          when others => Report.Failed ("Exception in Validate_String");
 175                         return Str;
 176       end Validate_String;
 177
 178
 179    begin
 180
 181       -- Check each character in turn, and if the character does not belong
 182       -- to the ISO_646 subset of type Character, replace it with an
 183       -- asterisk.  If the character is a member of the subset, the character
 184       -- should be returned unchanged.
 185
 186       Validate_Character (Char_1);
 187       Validate_Character (Char_2);
 188       Validate_Character (Char_3);
 189       Validate_Character (Char_4);
 190       Validate_Character (Char_5);
 191
 192       if Char_1 /= TC_Char_1 or Char_2 /= TC_Char_2 or
 193          Char_3 /= TC_Char_3 or Char_4 /= TC_Char_4 or
 194          Char_5 /= TC_Char_5
 195       then
 196          Report.Failed ("Incorrect ISO_646 character substitution");
 197       end if;
 198
 199       -- Non-ISO_646 characters
 200
 201       for i in 6..10 loop
 202          Validate_Character (Char_Array(i));
 203       end loop;
 204
 205       for i in 6..10 loop
 206          if Char_Array(i) /= TC_Char then
 207             Report.Failed ("Character position " & Integer'Image(i) &
 208                            " not replaced correctly");
 209          end if;
 210       end loop;
 211
 212
 213
 214       -- Check each string, and if the string contains characters that do not
 215       -- belong to the ISO_646 subset of type Character, replace that character
 216       -- in the string with an asterisk.  If the string is comprised of only
 217       -- ISO_646 characters, the string should be returned unchanged.
 218
 219
 220       Str_1 := Validate_String (Str_1);
 221       Str_2 := Validate_String (Str_2);
 222       Str_3 := Validate_String (Str_3);
 223       Str_4 := Validate_String (Str_4);
 224       Str_5 := Validate_String (Str_5);
 225
 226
 227       if Str_1 /= TC_Str_1 or
 228          Str_2 /= TC_Str_2 or
 229          Str_3 /= TC_Str_3 or
 230          Str_4 /= TC_Str_4 or
 231          Str_5 /= TC_Str_5
 232       then
 233          Report.Failed ("Incorrect ISO_646 character substitution in string");
 234       end if;
 235
 236
 237    exception
 238       when others => Report.Failed ("Exception raised in Test_Block");
 239    end Test_Block;
 240
 241    Report.Result;
 242
 243 end CXA3003;