gcc/testsuite/ada/acats/support/widechr.a

   1 -- WIDECHR.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 -- DESCRIPTION:
  27 --
  28 --      This program reads C250001.AW and C250002.AW; translates a special
  29 --      character sequence into characters and wide characters with positions
  30 --      above ASCII.DEL.  The resulting tests are written as C250001.A and
  31 --      C250002.A respectively.   This program may need to
  32 --      be modified if the Wide_Character representation recognized by
  33 --      your compiler differs from the Wide_Character
  34 --      representation generated by the package Ada.Wide_Text_IO.
  35 --      Modify this program as needed to translate that file.
  36 --
  37 --      A wide character is represented by an 8 character sequence:
  38 --
  39 --          ["abcd"]
  40 --
  41 --      where the character code represented is specified by four hexadecimal
  42 --      digits, abcd, with letters in upper case. For example the wide
  43 --      character with the code 16#AB13# is represented by the eight
  44 --      character sequence:
  45 --
  46 --          ["AB13"]
  47 --
  48 -- ASSUMPTIONS:
  49 --
  50 --      The path for these files is specified in ImpDef.
  51 --
  52 -- SPECIAL REQUIREMENTS:
  53 --
  54 --     Compile, bind and execute this program.  It will process the ".AW"
  55 --     tests, "translating" them to ".A" tests.
  56 --
  57 -- CHANGE HISTORY:
  58 --      11 DEC 96   SAIC   ACVC 2.1 Release
  59 --
  60 --      11 DEC 96   Keith  Constructed initial release version
  61 --!
  62
  63 with Ada.Text_IO;
  64 with Ada.Wide_Text_IO;
  65 with Ada.Strings.Fixed;
  66 with Impdef;
  67
  68 procedure WideChr is
  69
  70   -- Debug
  71   --
  72   -- To have the program generate trace/debugging information, de-comment
  73   -- the call to Put_Line
  74
  75   procedure Debug( S: String ) is
  76   begin
  77     null; -- Ada.Text_IO.Put_Line(S);
  78   end Debug;
  79
  80   package TIO renames Ada.Text_IO;
  81   package WIO renames Ada.Wide_Text_IO;
  82   package SF renames Ada.Strings.Fixed;
  83
  84   In_File : TIO.File_Type;
  85
  86   -- This program is actually dual-purpose.  It translates the ["xxxx"]
  87   -- notation to Wide_Character, as well as a similar notation ["xx"] into
  88   -- Character.  The intent of the latter being the ability to represent
  89   -- literals in the Latin-1 character set that have position numbers
  90   -- greater than ASCII.DEL.  The variable Output_Mode drives the algorithms
  91   -- to generate Wide_Character output (Wide) or Character output (Narrow).
  92
  93   type Output_Modes is ( Wide, Narrow );
  94   Output_Mode : Output_Modes := Wide;
  95
  96   Wide_Out   : WIO.File_Type;
  97   Narrow_Out : TIO.File_Type;
  98
  99   In_Line   : String(1..132); -- SB: $MAX_LINE_LENGTH
 100
 101   -- Index variables
 102   --
 103   -- the following index variables: In_Length, Front, Open_Bracket and
 104   -- Close_Bracket are used by the scanning software to keep track of
 105   -- what's where.
 106   --
 107   -- In_Length stores the value returned by Ada.Text_IO.Get_Line indicating
 108   -- the position of the last "useful" character in the string In_Line.
 109   --
 110   -- Front retains the index of the first non-translating character in
 111   -- In_Line, it is used to indicate the starting index of the portion of
 112   -- the string to save without special interpretation.  In the example
 113   -- below, where there are two consecutive characters to translate, we see
 114   -- that Front will assume three different values processing the string,
 115   -- these are indicated by the digits '1', '2' & '3' in the comment
 116   -- attached to the declaration.  The processing software will dump
 117   -- In_Line(Front..Open_Bracket-1) to the output stream.  Note that in
 118   -- the second case, this results in a null string, and in the third case,
 119   -- where Open_Bracket does not obtain a third value, the slice
 120   -- In_Line(Front..In_Length) is used instead.
 121   --
 122   -- Open_Bracket and Close_Bracket are used to retain the starting index
 123   -- of the character pairs [" and "] respectively.  For the purposes of
 124   -- this software the character pairs are what are considered to be the
 125   -- "brackets" enclosing the hexadecimal values to be translated.
 126   --  Looking at the example below you will see where these index variables
 127   -- will "point" in the first and second case.
 128
 129   In_Length     : Natural := 0;  --->  Some_["0A12"]["0B13"]_Thing
 130   Front         : Natural := 0;  --  1              2       3
 131   Open_Bracket  : Natural := 0;  --         1       2
 132   Close_Bracket : Natural := 0;  --               1       2
 133
 134   -- Xlation
 135   --
 136   -- This translation table gives an easy way to translate the "decimal"
 137   -- value of a hex digit (as represented by a Latin-1 character)
 138
 139   type Xlate is array(Character range '0'..'F') of Natural;
 140   Xlation : constant Xlate :=
 141             ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
 142              '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
 143              'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
 144              'F' => 15,
 145              others => 0);
 146
 147   -- To_Ch
 148   --
 149   -- This function takes a string which is assumed to be trimmed to just a
 150   -- hexadecimal representation of a Latin-1 character.  The result of the
 151   -- function is the Latin-1 character at the position designated by the
 152   -- incoming hexadecimal value.  (hexadecimal in human readable form)
 153
 154   function To_Ch( S:String ) return Character is
 155     Numerical : Natural := 0;
 156   begin
 157     Debug("To Wide: " & S);
 158     for I in S'Range loop
 159       Numerical := Numerical * 16 + Xlation(S(I));
 160     end loop;
 161     return Character'Val(Numerical);
 162   exception
 163     when Constraint_Error => return '_';
 164   end To_Ch;
 165
 166   -- To_Wide
 167   --
 168   -- This function takes a string which is assumed to be trimmed to just a
 169   -- hexadecimal representation of a Wide_character.  The result of the
 170   -- function is the Wide_character at the position designated by the
 171   -- incoming hexadecimal value.  (hexadecimal in human readable form)
 172
 173   function To_Wide( S:String ) return Wide_character is
 174     Numerical : Natural := 0;
 175   begin
 176     Debug("To Wide: " & S);
 177     for I in S'Range loop
 178       Numerical := Numerical * 16 + Xlation(S(I));
 179     end loop;
 180     return Wide_Character'Val(Numerical);
 181   exception
 182     when Constraint_Error => return '_';
 183   end To_Wide;
 184
 185   -- Make_Wide
 186   --
 187   -- this function converts a String to a Wide_String
 188
 189   function Make_Wide( S: String ) return Wide_String is
 190     W: Wide_String(S'Range);
 191   begin
 192     for I in S'Range loop
 193       W(I) := Wide_Character'Val( Character'Pos(S(I)) );
 194     end loop;
 195     return W;
 196   end Make_Wide;
 197
 198   -- Close_Files
 199   --
 200   -- Depending on which input we've processed, close the output file
 201
 202   procedure Close_Files is
 203   begin
 204     TIO.Close(In_File);
 205     if Output_Mode = Wide then
 206       WIO.Close(Wide_Out);
 207     else
 208       TIO.Close(Narrow_Out);
 209     end if;
 210   end Close_Files;
 211
 212   -- Process
 213   --
 214   -- for all lines in the input file
 215   --   scan the file for occurrences of [" and "]
 216   --     for found occurrence, attempt translation of the characters found
 217   --     between the brackets.  As a safeguard, unrecognizable character
 218   --     sequences will be replaced with the underscore character.  This
 219   --     handles the cases in the tests where the test documentation includes
 220   --     examples that are non-conformant: i.e. ["abcd"] or ["XXXX"]
 221
 222   procedure Process( Input_File_Name: String ) is
 223   begin
 224     TIO.Open(In_File,TIO.In_File,Input_File_Name & ".aw" );
 225
 226     if Output_Mode = Wide then
 227       WIO.Create(Wide_Out,WIO.Out_File, Input_File_Name & ".a" );
 228     else
 229       TIO.Create(Narrow_Out,TIO.Out_File, Input_File_Name & ".a" );
 230     end if;
 231
 232     File: while not TIO.End_Of_File( In_File ) loop
 233       In_Line := (others => ' ');
 234       TIO.Get_Line(In_File,In_Line,In_Length);
 235       Debug(In_Line(1..In_Length));
 236
 237       Front := 1;
 238
 239       Line: loop
 240              -- scan for next occurrence of ["abcd"]
 241              Open_Bracket := SF.Index( In_Line(Front..In_Length), "[""" );
 242              Close_Bracket := SF.Index( In_Line(Front..In_Length), """]" );
 243              Debug( "[=" & Natural'Image(Open_Bracket) );
 244              Debug( "]=" & Natural'Image(Close_Bracket) );
 245
 246              if Open_Bracket = 0 or Close_Bracket = 0 then
 247         -- done with the line, output remaining characters and exit
 248                Debug("Done with line");
 249                if Output_Mode = Wide then
 250                  WIO.Put_Line(Wide_Out, Make_Wide(In_Line(Front..In_Length)) );
 251                else
 252                  TIO.Put_Line(Narrow_Out, In_Line(Front..In_Length) );
 253                end if;
 254                exit Line;
 255              else
 256                -- output the "normal" stuff up to the bracket
 257                if Output_Mode = Wide then
 258                  WIO.Put(Wide_Out, Make_Wide(In_Line(Front..Open_Bracket-1)) );
 259                else
 260                  TIO.Put(Narrow_Out, In_Line(Front..Open_Bracket-1) );
 261                end if;
 262
 263                -- point beyond the closing bracket
 264                Front := Close_Bracket +2;
 265
 266                -- output the translated hexadecimal character
 267                if Output_Mode = Wide then
 268                  WIO.Put(Wide_Out,
 269                             To_Wide( In_Line(Open_Bracket+2..Close_Bracket-1) ));
 270                else
 271                  TIO.Put(Narrow_Out,
 272                                     To_Ch( In_Line(Open_Bracket+2..Close_Bracket-1)) );
 273                end if;
 274         end if;
 275       end loop Line;
 276
 277     end loop File;
 278
 279     Close_Files;
 280   exception
 281     when others =>
 282       Ada.Text_IO.Put_Line("Error in processing " & Input_File_Name);
 283       raise;
 284   end Process;
 285
 286 begin
 287
 288   Output_Mode := Wide;
 289   Process( Impdef.Wide_Character_Test );
 290
 291   Output_Mode := Narrow;
 292   Process( Impdef.Upper_Latin_Test );
 293
 294 end WideChr;