aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/support/widechr.a
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/ada/acats/support/widechr.a')
-rw-r--r--gcc/testsuite/ada/acats/support/widechr.a294
1 files changed, 0 insertions, 294 deletions
diff --git a/gcc/testsuite/ada/acats/support/widechr.a b/gcc/testsuite/ada/acats/support/widechr.a
deleted file mode 100644
index 2eac588b890..00000000000
--- a/gcc/testsuite/ada/acats/support/widechr.a
+++ /dev/null
@@ -1,294 +0,0 @@
--- 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;