URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [support/] [widechr.a] - Rev 294
Compare with Previous | Blame | View Log
-- 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;