path: root/gcc/testsuite/ada/acats/support/widechr.a

-- WIDECHR.A
--
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- DESCRIPTION:
--
--      This program reads C250001.AW and C250002.AW; translates a special
--      character sequence into characters and wide characters with positions
--      above ASCII.DEL.  The resulting tests are written as C250001.A and
--      C250002.A respectively.   This program may need to
--      be modified if the Wide_Character representation recognized by
--      your compiler differs from the Wide_Character
--      representation generated by the package Ada.Wide_Text_IO.
--      Modify this program as needed to translate that file.
--
--      A wide character is represented by an 8 character sequence:
--
--          ["abcd"]
--
--      where the character code represented is specified by four hexadecimal
--      digits, abcd, with letters in upper case. For example the wide
--      character with the code 16#AB13# is represented by the eight
--      character sequence:
--
--          ["AB13"]
--
-- ASSUMPTIONS:
--
--      The path for these files is specified in ImpDef.
--
-- SPECIAL REQUIREMENTS:
--
--     Compile, bind and execute this program.  It will process the ".AW"
--     tests, "translating" them to ".A" tests.
--
-- CHANGE HISTORY:
--      11 DEC 96   SAIC   ACVC 2.1 Release
--
--      11 DEC 96   Keith  Constructed initial release version
--!

with Ada.Text_IO;
with Ada.Wide_Text_IO;
with Ada.Strings.Fixed;
with Impdef;

procedure WideChr is

  -- Debug
  --
  -- To have the program generate trace/debugging information, de-comment
  -- the call to Put_Line

  procedure Debug( S: String ) is
  begin
    null; -- Ada.Text_IO.Put_Line(S);
  end Debug;

  package TIO renames Ada.Text_IO;
  package WIO renames Ada.Wide_Text_IO;
  package SF renames Ada.Strings.Fixed;

  In_File : TIO.File_Type;

  -- This program is actually dual-purpose.  It translates the ["xxxx"]
  -- notation to Wide_Character, as well as a similar notation ["xx"] into
  -- Character.  The intent of the latter being the ability to represent
  -- literals in the Latin-1 character set that have position numbers
  -- greater than ASCII.DEL.  The variable Output_Mode drives the algorithms
  -- to generate Wide_Character output (Wide) or Character output (Narrow).

  type Output_Modes is ( Wide, Narrow );
  Output_Mode : Output_Modes := Wide;

  Wide_Out   : WIO.File_Type;
  Narrow_Out : TIO.File_Type;

  In_Line   : String(1..132); -- SB: $MAX_LINE_LENGTH

  -- Index variables
  -- 
  -- the following index variables: In_Length, Front, Open_Bracket and
  -- Close_Bracket are used by the scanning software to keep track of
  -- what's where.
  --
  -- In_Length stores the value returned by Ada.Text_IO.Get_Line indicating
  -- the position of the last "useful" character in the string In_Line.
  --
  -- Front retains the index of the first non-translating character in
  -- In_Line, it is used to indicate the starting index of the portion of
  -- the string to save without special interpretation.  In the example
  -- below, where there are two consecutive characters to translate, we see
  -- that Front will assume three different values processing the string,
  -- these are indicated by the digits '1', '2' & '3' in the comment
  -- attached to the declaration.  The processing software will dump
  -- In_Line(Front..Open_Bracket-1) to the output stream.  Note that in
  -- the second case, this results in a null string, and in the third case,
  -- where Open_Bracket does not obtain a third value, the slice
  -- In_Line(Front..In_Length) is used instead.
  --
  -- Open_Bracket and Close_Bracket are used to retain the starting index
  -- of the character pairs [" and "] respectively.  For the purposes of
  -- this software the character pairs are what are considered to be the
  -- "brackets" enclosing the hexadecimal values to be translated.
  --  Looking at the example below you will see where these index variables
  -- will "point" in the first and second case.

  In_Length     : Natural := 0;  --->  Some_["0A12"]["0B13"]_Thing
  Front         : Natural := 0;  --  1              2       3
  Open_Bracket  : Natural := 0;  --         1       2
  Close_Bracket : Natural := 0;  --               1       2

  -- Xlation
  --
  -- This translation table gives an easy way to translate the "decimal"
  -- value of a hex digit (as represented by a Latin-1 character)

  type Xlate is array(Character range '0'..'F') of Natural;
  Xlation : constant Xlate :=
            ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
             '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
             'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
             'F' => 15,
             others => 0);

  -- To_Ch
  --
  -- This function takes a string which is assumed to be trimmed to just a
  -- hexadecimal representation of a Latin-1 character.  The result of the
  -- function is the Latin-1 character at the position designated by the
  -- incoming hexadecimal value.  (hexadecimal in human readable form)

  function To_Ch( S:String ) return Character is
    Numerical : Natural := 0;
  begin
    Debug("To Wide: " & S);
    for I in S'Range loop
      Numerical := Numerical * 16 + Xlation(S(I));
    end loop;
    return Character'Val(Numerical);
  exception
    when Constraint_Error => return '_';
  end To_Ch;

  -- To_Wide
  --
  -- This function takes a string which is assumed to be trimmed to just a
  -- hexadecimal representation of a Wide_character.  The result of the
  -- function is the Wide_character at the position designated by the
  -- incoming hexadecimal value.  (hexadecimal in human readable form)

  function To_Wide( S:String ) return Wide_character is
    Numerical : Natural := 0;
  begin
    Debug("To Wide: " & S);
    for I in S'Range loop
      Numerical := Numerical * 16 + Xlation(S(I));
    end loop;
    return Wide_Character'Val(Numerical);
  exception
    when Constraint_Error => return '_';
  end To_Wide;

  -- Make_Wide
  --
  -- this function converts a String to a Wide_String

  function Make_Wide( S: String ) return Wide_String is
    W: Wide_String(S'Range);
  begin
    for I in S'Range loop
      W(I) := Wide_Character'Val( Character'Pos(S(I)) );
    end loop;
    return W;
  end Make_Wide;

  -- Close_Files
  --
  -- Depending on which input we've processed, close the output file

  procedure Close_Files is
  begin
    TIO.Close(In_File);
    if Output_Mode = Wide then
      WIO.Close(Wide_Out);
    else
      TIO.Close(Narrow_Out);
    end if;
  end Close_Files;

  -- Process
  --
  -- for all lines in the input file
  --   scan the file for occurrences of [" and "]
  --     for found occurrence, attempt translation of the characters found
  --     between the brackets.  As a safeguard, unrecognizable character
  --     sequences will be replaced with the underscore character.  This
  --     handles the cases in the tests where the test documentation includes
  --     examples that are non-conformant: i.e. ["abcd"] or ["XXXX"]

  procedure Process( Input_File_Name: String ) is
  begin
    TIO.Open(In_File,TIO.In_File,Input_File_Name & ".aw" );

    if Output_Mode = Wide then
      WIO.Create(Wide_Out,WIO.Out_File, Input_File_Name & ".a" );
    else
      TIO.Create(Narrow_Out,TIO.Out_File, Input_File_Name & ".a" );
    end if;

    File: while not TIO.End_Of_File( In_File ) loop
      In_Line := (others => ' ');
      TIO.Get_Line(In_File,In_Line,In_Length);
      Debug(In_Line(1..In_Length));

      Front := 1;

      Line: loop
	     -- scan for next occurrence of ["abcd"]
	     Open_Bracket := SF.Index( In_Line(Front..In_Length), "[""" );
	     Close_Bracket := SF.Index( In_Line(Front..In_Length), """]" );
	     Debug( "[=" & Natural'Image(Open_Bracket) );
	     Debug( "]=" & Natural'Image(Close_Bracket) );

	     if Open_Bracket = 0 or Close_Bracket = 0 then
        -- done with the line, output remaining characters and exit
	       Debug("Done with line");
	       if Output_Mode = Wide then
	         WIO.Put_Line(Wide_Out, Make_Wide(In_Line(Front..In_Length)) );
	       else
	         TIO.Put_Line(Narrow_Out, In_Line(Front..In_Length) );
	       end if;
	       exit Line;
	     else
	       -- output the "normal" stuff up to the bracket
	       if Output_Mode = Wide then
	         WIO.Put(Wide_Out, Make_Wide(In_Line(Front..Open_Bracket-1)) );
	       else
	         TIO.Put(Narrow_Out, In_Line(Front..Open_Bracket-1) );
	       end if;

	       -- point beyond the closing bracket
	       Front := Close_Bracket +2;

	       -- output the translated hexadecimal character
	       if Output_Mode = Wide then
	         WIO.Put(Wide_Out,
	              	    To_Wide( In_Line(Open_Bracket+2..Close_Bracket-1) ));
	       else
	         TIO.Put(Narrow_Out,
		                    To_Ch( In_Line(Open_Bracket+2..Close_Bracket-1)) );
	       end if;
     	end if;
      end loop Line;

    end loop File;
    
    Close_Files;
  exception
    when others =>
      Ada.Text_IO.Put_Line("Error in processing " & Input_File_Name);
      raise;
  end Process;

begin

  Output_Mode := Wide;
  Process( Impdef.Wide_Character_Test );

  Output_Mode := Narrow;
  Process( Impdef.Upper_Latin_Test );

end WideChr;