-- 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;