diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/support/widechr.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/support/widechr.a | 294 |
1 files changed, 294 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/support/widechr.a b/gcc-4.9/gcc/testsuite/ada/acats/support/widechr.a new file mode 100644 index 000000000..2eac588b8 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/support/widechr.a @@ -0,0 +1,294 @@ +-- 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; |