+++ /dev/null
--- CXA3004.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.
---*
---
--- OBJECTIVE:
--- Check that the functions defined in package Ada.Characters.Handling
--- for classification of and conversion between Wide_Character and
--- Character values produce correct results when given the appropriate
--- Character and String inputs.
---
--- TEST DESCRIPTION:
--- This test demonstrates the functions defined in package
--- Ada.Characters.Handling which provide for the classification of and
--- conversion between Wide_Characters and Characters, in character
--- variables and strings.
--- Each of the functions is provided with input values that are of the
--- appropriate range. The results of the function processing are
--- subsequently evaluated.
---
--- APPLICABILITY CRITERIA:
--- Applicable to all implementations using the Latin_1 set as the
--- definition of Character.
---
---
--- CHANGE HISTORY:
--- 06 Dec 94 SAIC ACVC 2.0
--- 27 Dec 94 SAIC Corrected variable names.
---
---!
-
-with Report;
-with Ada.Characters.Handling;
-
-procedure CXA3004 is
-begin
-
- Report.Test ("CXA3004", "Check that the functions defined in package " &
- "Ada.Characters.Handling for classification " &
- "of and conversion between Wide_Character and " &
- "Character values produce correct results " &
- "when given the appropriate Character " &
- "and String inputs");
-
- Test_Block:
- declare
-
- package ACH renames Ada.Characters.Handling;
-
- Char_End : Integer := 255;
- WC_Start : Integer := 256;
- Sub_Char : Character := '*';
-
- Blank : Character := ' ';
- First_Char : Character := Character'First;
- Last_Char : Character := Character'Last;
- F_Char : Character := 'F';
-
-
- First_Wide_Char : Wide_Character := Wide_Character'First;
- Last_Non_Wide_Char : Wide_Character := Wide_Character'Val(Char_End);
- First_Unique_Wide_Char : Wide_Character := Wide_Character'Val(WC_Start);
- Last_Wide_Char : Wide_Character := Wide_Character'Last;
-
- A_String : String (1..3) := First_Char & 'X' & Last_Char;
- A_Wide_String : Wide_String (1..3) := First_Wide_Char &
- ACH.To_Wide_Character('X') &
- ACH.To_Wide_Character(Last_Char);
-
- Unique_Wide_String : Wide_String (1..2) := First_Unique_Wide_Char &
- Last_Wide_Char;
-
- Mixed_Wide_String : Wide_String (1..6) := ACH.To_Wide_Character('A') &
- First_Wide_Char &
- Last_Non_Wide_Char &
- First_Unique_Wide_Char &
- Last_Wide_Char &
- ACH.To_Wide_Character('Z');
-
-
- Basic_Char : Character := 'A';
- Basic_Wide_Char : Wide_Character := 'A';
- Basic_String : String (1..6) := "ABCXYZ";
- Basic_Wide_String : Wide_String (1..6) := "ABCXYZ";
-
- begin
-
-
- -- Function Is_Character
-
-
- if not ACH.Is_Character(First_Wide_Char) then
- Report.Failed ("Incorrect result from Is_Character - 1");
- end if;
-
-
- if ACH.Is_Character(First_Unique_Wide_Char) or
- ACH.Is_Character(Last_Wide_Char)
- then
- Report.Failed ("Incorrect result from Is_Character - 2");
- end if;
-
-
- -- Function Is_String
-
-
- if not ACH.Is_String(A_Wide_String) then
- Report.Failed ("Incorrect result from Is_String - 1");
- end if;
-
-
- if ACH.Is_String(Unique_Wide_String) or
- ACH.Is_String(Mixed_Wide_String)
- then
- Report.Failed ("Incorrect result from Is_String - 2");
- end if;
-
-
- -- Function To_Character
-
-
- -- Use default substitution character in call of To_Character.
-
- if ACH.To_Character(First_Wide_Char) /= First_Char or
- ACH.To_Character(Last_Non_Wide_Char) /= Last_Char
- then
- Report.Failed ("Incorrect result from To_Character - 1");
- end if;
-
-
- -- Provide a substitution character for use with To_Character.
-
- if ACH.To_Character(First_Unique_Wide_Char, Blank) /= Blank or
- ACH.To_Character(First_Unique_Wide_Char, Sub_Char) /= Sub_Char or
- ACH.To_Character(Last_Wide_Char) /= ' ' -- default
- then
- Report.Failed ("Incorrect result from To_Character - 2");
- end if;
-
-
- -- Function To_String
-
-
- if ACH.To_String(A_Wide_String) /= A_String then
- Report.Failed ("Incorrect result from To_String - 1");
- end if;
-
-
- if ACH.To_String(Unique_Wide_String, Sub_Char) /= "**" then
- Report.Failed ("Incorrect result from To_String - 2");
- end if;
-
-
-
- if ACH.To_String(Mixed_Wide_String, Sub_Char) /=
- ('A' & First_Char & Last_Char & "**" & 'Z') or
- ACH.To_String(Mixed_Wide_String, Sub_Char) /=
- (ACH.To_Character(Mixed_Wide_String(1), Sub_Char) &
- ACH.To_Character(Mixed_Wide_String(2), Sub_Char) &
- ACH.To_Character(Mixed_Wide_String(3), Sub_Char) &
- ACH.To_Character(Mixed_Wide_String(4), Sub_Char) &
- ACH.To_Character(Mixed_Wide_String(5), Sub_Char) &
- ACH.To_Character(Mixed_Wide_String(6), Sub_Char))
- then
- Report.Failed ("Incorrect result from To_String - 3");
- end if;
-
-
- -- Function To_Wide_Character
-
-
- if ACH.To_Wide_Character(Basic_Char) /= Basic_Wide_Char then
- Report.Failed ("Incorrect result from To_Wide_Character");
- end if;
-
-
- -- Function To_Wide_String
-
-
- if not (ACH.To_Wide_String(Basic_String) = Basic_Wide_String) then
- Report.Failed ("Incorrect result from To_Wide_String");
- end if;
-
-
- -- Functions Used In Combination
-
- if not ACH.Is_Character (ACH.To_Wide_Character (
- ACH.To_Character(First_Wide_Char)))
- then
- Report.Failed ("Incorrect result from functions in combination - 1");
- end if;
-
-
- if not ACH.Is_String(ACH.To_Wide_String(ACH.To_String(A_Wide_String)))
- then
- Report.Failed ("Incorrect result from functions in combination - 2");
- end if;
-
-
- if ACH.To_String(ACH.To_Wide_Character('A') &
- ACH.To_Wide_Character(F_Char) &
- ACH.To_Wide_Character('Z')) /= "AFZ"
- then
- Report.Failed ("Incorrect result from functions in combination - 3");
- end if;
-
-
- exception
- when others => Report.Failed ("Exception raised in Test_Block");
- end Test_Block;
-
-
- Report.Result;
-
-end CXA3004;
+++ /dev/null
--- CXB30061.AM
---
--- 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.
---*
---
--- OBJECTIVE:
--- Check that the function To_C maps between the Ada type Wide_Character
--- and the C type wchar_t.
---
--- Check that the function To_Ada maps between the C type wchar_t and
--- the Ada type Wide_Character.
---
--- Check that the function Is_Nul_Terminated returns True if the
--- wchar_array parameter contains wide_nul, and otherwise False.
---
--- Check that the function To_C produces a correct wchar_array result,
--- with lower bound of 0, and length dependent upon the Item and
--- Append_Nul parameters.
---
--- Check that the function To_Ada produces a correct wide_string result,
--- with lower bound of 1, and length dependent upon the Item and
--- Trim_Nul parameters.
---
--- Check that the function To_Ada raises Terminator_Error if the
--- parameter Trim_Nul is set to True, but the actual Item parameter
--- does not contain the wide_nul wchar_t.
---
--- TEST DESCRIPTION:
--- This test uses a variety of Wide_Character, wchar_t, Wide_String, and
--- wchar_array objects to test versions of the To_C, To_Ada, and
--- Is_Nul_Terminated functions.
---
--- This test assumes that the following characters are all included
--- in the implementation defined type Interfaces.C.wchar_t:
--- ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
---
--- APPLICABILITY CRITERIA:
--- This test is applicable to all implementations that provide
--- package Interfaces.C. If an implementation provides
--- package Interfaces.C, this test must compile, execute, and
--- report "PASSED".
---
--- SPECIAL REQUIREMENTS:
--- The file CXB30060.C must be compiled with a C compiler.
--- Implementation dialects of C may require alteration of
--- the C program syntax (see individual C files).
---
--- Note that the compiled C code must be bound with the compiled Ada
--- code to create an executable image. An implementation must provide
--- the necessary commands to accomplish this.
---
--- Note that the C code included in CXB30060.C conforms
--- to ANSI-C. Modifications to these files may be required for other
--- C compilers. An implementation must provide the necessary
--- modifications to satisfy the function requirements.
---
--- TEST FILES:
--- The following files comprise this test:
---
--- CXB30060.C
--- CXB30061.AM
---
--- CHANGE HISTORY:
--- 07 Sep 95 SAIC Initial prerelease version.
--- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
--- 13 Sep 99 RLB Replaced (bogus) Unchecked_Conversions with a
--- C function character generator.
---
---!
-
-with Report;
-with Interfaces.C; -- N/A => ERROR
-with Ada.Characters.Latin_1;
-with Ada.Characters.Handling;
-with Ada.Exceptions;
-with Ada.Strings.Wide_Fixed;
-with Impdef;
-
-procedure CXB30061 is
-begin
-
- Report.Test ("CXB3006", "Check that the functions To_C and To_Ada " &
- "produce correct results");
-
- Test_Block:
- declare
-
- use Interfaces, Interfaces.C;
- use Ada.Characters, Ada.Characters.Latin_1, Ada.Characters.Handling;
- use Ada.Strings.Wide_Fixed;
-
- First_Character,
- Last_Character : Character;
- TC_wchar_t,
- TC_Low_wchar_t,
- TC_High_wchar_t : wchar_t := wchar_t'First;
- TC_Wide_String : Wide_String(1..8) := (others => Wide_Character'First);
- TC_wchar_array : wchar_array(0..7) := (others => C.wide_nul);
-
- -- The function Char_Gen returns a character corresponding to its
- -- argument.
- -- Value 0 .. 9 ==> '0' .. '9'
- -- Value 10 .. 19 ==> 'A' .. 'J'
- -- Value 20 .. 29 ==> 'k' .. 't'
- -- Value 30 ==> ' '
- -- Value 31 ==> '.'
- -- Value 32 ==> ','
-
- function Char_Gen (Value : in int) return wchar_t;
-
- -- Use the user-defined C function char_gen as a completion to the
- -- function specification above.
-
- pragma Import (Convention => C,
- Entity => Char_Gen,
- External_Name => Impdef.CXB30060_External_Name);
-
- begin
-
- -- Check that the functions To_C and To_Ada map between the Ada type
- -- Wide_Character and the C type wchar_t.
-
- if To_C(To_Wide_Character(Ada.Characters.Latin_1.NUL)) /=
- Interfaces.C.wide_nul
- then
- Report.Failed("Incorrect result from To_C with NUL character input");
- end if;
-
- First_Character := Report.Ident_Char('k');
- Last_Character := Report.Ident_Char('t');
- for i in First_Character..Last_Character loop
- if To_C(Item => To_Wide_Character(i)) /=
- Char_Gen(Character'Pos(i) - Character'Pos('k') + 20)
- then
- Report.Failed("Incorrect result from To_C with lower case " &
- "alphabetic wide character input");
- end if;
- end loop;
-
- First_Character := Report.Ident_Char('A');
- Last_Character := Report.Ident_Char('J');
- for i in First_Character..Last_Character loop
- if To_C(Item => To_Wide_Character(i)) /=
- Char_Gen(Character'Pos(i) - Character'Pos('A') + 10)
- then
- Report.Failed("Incorrect result from To_C with upper case " &
- "alphabetic wide character input");
- end if;
- end loop;
-
- First_Character := Report.Ident_Char('0');
- Last_Character := Report.Ident_Char('9');
- for i in First_Character..Last_Character loop
- if To_C(Item => To_Wide_Character(i)) /=
- Char_Gen(Character'Pos(i) - Character'Pos('0'))
- then
- Report.Failed("Incorrect result from To_C with digit " &
- "wide character input");
- end if;
- end loop;
-
- if To_C(Item => To_Wide_Character(' ')) /= Char_Gen(30)
- then
- Report.Failed("Incorrect result from To_C with space " &
- "wide character input");
- end if;
-
- if To_C(Item => To_Wide_Character('.')) /= Char_Gen(31)
- then
- Report.Failed("Incorrect result from To_C with dot " &
- "wide character input");
- end if;
-
- if To_C(Item => To_Wide_Character(',')) /= Char_Gen(32)
- then
- Report.Failed("Incorrect result from To_C with comma " &
- "wide character input");
- end if;
-
- if To_Ada(Interfaces.C.wide_nul) /=
- To_Wide_Character(Ada.Characters.Latin_1.NUL)
- then
- Report.Failed("Incorrect result from To_Ada with wide_nul " &
- "wchar_t input");
- end if;
-
- for Code in int range
- int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
- -- 'k' .. 't'
- if To_Ada(Item => Char_Gen(Code)) /=
- To_Wide_Character(Character'Val (Character'Pos('k') + (Code - 20)))
- then
- Report.Failed("Incorrect result from To_Ada with lower case " &
- "alphabetic wchar_t input");
- end if;
- end loop;
-
- for Code in int range
- int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
- -- 'A' .. 'J'
- if To_Ada(Item => Char_Gen(Code)) /=
- To_Wide_Character(Character'Val (Character'Pos('A') + (Code - 10)))
- then
- Report.Failed("Incorrect result from To_Ada with upper case " &
- "alphabetic wchar_t input");
- end if;
- end loop;
-
- for Code in int range
- int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
- -- '0' .. '9'
- if To_Ada(Item => Char_Gen(Code)) /=
- To_Wide_Character(Character'Val (Character'Pos('0') + (Code)))
- then
- Report.Failed("Incorrect result from To_Ada with digit " &
- "wchar_t input");
- end if;
- end loop;
-
- if To_Ada(Item => Char_Gen(30)) /= ' ' then
- Report.Failed("Incorrect result from To_Ada with space " &
- "char input");
- end if;
- if To_Ada(Item => Char_Gen(31)) /= '.' then
- Report.Failed("Incorrect result from To_Ada with dot " &
- "char input");
- end if;
- if To_Ada(Item => Char_Gen(32)) /= ',' then
- Report.Failed("Incorrect result from To_Ada with comma " &
- "char input");
- end if;
-
- -- Check that the function Is_Nul_Terminated produces correct results
- -- whether or not the wchar_array argument contains the
- -- Ada.Interfaces.C.wide_nul character.
-
- TC_Wide_String := "abcdefgh";
- if Is_Nul_Terminated(Item => To_C(TC_Wide_String, Append_Nul => False))
- then
- Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
- "wide_nul wchar_t is present");
- end if;
-
- if not Is_Nul_Terminated(To_C(TC_Wide_String, Append_Nul => True)) then
- Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
- "wide_nul wchar_t is present");
- end if;
-
-
-
- -- Now that we've tested the character/char versions of To_Ada and To_C,
- -- use them to test the string versions.
-
- declare
- i : size_t := 0;
- j : integer := 1;
- Incorrect_Conversion : Boolean := False;
-
- TC_No_wide_nul : constant wchar_array := To_C(TC_Wide_String,
- False);
- TC_wide_nul_Appended : constant wchar_array := To_C(TC_Wide_String,
- True);
- begin
-
- -- Check that the function To_C produces a wchar_array result with
- -- lower bound of 0, and length dependent upon the Item and
- -- Append_Nul parameters (if Append_Nul is True, length is
- -- Item'Length + 1; if False, length is Item'Length).
-
- if TC_No_wide_nul'First /= 0 or TC_wide_nul_Appended'First /= 0 then
- Report.Failed("Incorrect lower bound from Function To_C");
- end if;
-
- if TC_No_wide_nul'Length /= TC_Wide_String'Length then
- Report.Failed("Incorrect length returned from Function To_C " &
- "when Append_Nul => False");
- end if;
-
- if TC_wide_nul_Appended'Length /= TC_Wide_String'Length + 1 then
- Report.Failed("Incorrect length returned from Function To_C " &
- "when Append_Nul => True");
- end if;
-
- if not Is_Nul_Terminated(TC_wide_nul_Appended) then
- Report.Failed("No wide_nul appended to the wide_string " &
- "parameter during conversion to wchar_array " &
- "by function To_C");
- end if;
-
- for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
- if TC_No_wide_nul(i) /= To_C(To_Wide_Character(TC_char)) or
- TC_wide_nul_Appended(i) /= To_C(To_Wide_Character(TC_char)) then
- -- Use single character To_C.
- Incorrect_Conversion := True;
- end if;
- i := i + 1;
- end loop;
-
- if Incorrect_Conversion then
- Report.Failed("Incorrect result from To_C with wide_string input " &
- "and wchar_array result");
- end if;
-
-
- -- Check that the function To_Ada produces a wide_string result with
- -- lower bound of 1, and length dependent upon the Item and
- -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
- -- if False, length will be the length of the slice of Item prior to
- -- the first wide_nul).
-
- declare
- TC_No_NUL_Wide_String : constant Wide_String :=
- To_Ada(Item => TC_wide_nul_Appended, Trim_Nul => True);
-
- TC_NUL_Appended_Wide_String : constant Wide_String :=
- To_Ada(TC_wide_nul_Appended, False);
-
- begin
-
- if TC_No_NUL_Wide_String'First /= 1 or
- TC_NUL_Appended_Wide_String'First /= 1
- then
- Report.Failed("Incorrect lower bound from Function To_Ada");
- end if;
-
- if TC_No_NUL_Wide_String'Length /= TC_Wide_String'Length then
- Report.Failed("Incorrect length returned from Function " &
- "To_Ada when Trim_Nul => True");
- end if;
-
- if TC_NUL_Appended_Wide_String'Length /=
- TC_Wide_String'Length + 1
- then
- Report.Failed("Incorrect length returned from Function " &
- "To_Ada when Trim_Nul => False");
- end if;
-
- for TC_Character in Wide_Character'('a') .. Wide_Character'('h') loop
- if TC_No_NUL_Wide_String(j) /= TC_Character or
- TC_NUL_Appended_Wide_String(j) /= TC_Character
- then
- Report.Failed("Incorrect result from To_Ada with " &
- "char_array input, index = " &
- Integer'Image(j));
- end if;
- j := j + 1;
- end loop;
-
- end;
-
-
- -- Check that the function To_Ada raises Terminator_Error if the
- -- parameter Trim_Nul is set to True, but the actual Item parameter
- -- does not contain the wide_nul wchar_t.
-
- begin
- TC_Wide_String := To_Ada(TC_No_wide_nul, Trim_Nul => True);
- Report.Failed("Terminator_Error not raised when Item " &
- "parameter of To_Ada does not contain the " &
- "wide_nul wchar_t, but parameter Trim_Nul " &
- "=> True");
- Report.Comment
- (To_String(TC_Wide_String) & " printed to defeat optimization");
- exception
- when Terminator_Error => null; -- OK, expected exception.
- when others =>
- Report.Failed("Incorrect exception raised by function " &
- "To_Ada when the Item parameter does not " &
- "contain the wide_nul wchar_t, but " &
- "parameter Trim_Nul => True");
- end;
-
- end;
-
- exception
- when The_Error : others =>
- Report.Failed
- ("The following exception was raised in the Test_Block: " &
- Ada.Exceptions.Exception_Name(The_Error));
- end Test_Block;
-
- Report.Result;
-
-end CXB30061;
projects / platform / upstream / gcc.git / commitdiff