| -- CXB30041.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 functions To_C and To_Ada map between the Ada type |
| -- Character and the C type char. |
| -- |
| -- Check that the function Is_Nul_Terminated returns True if the |
| -- char_array parameter contains nul, and otherwise False. |
| -- |
| -- Check that the function To_C produces a correct char_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 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 nul char. |
| -- |
| -- TEST DESCRIPTION: |
| -- This test uses a variety of Character, char, String, and char_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.char: |
| -- ' ', ',', '.', '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 CXB30040.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 CXB30040.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: |
| -- |
| -- CXB30040.C |
| -- CXB30041.AM |
| -- |
| -- CHANGE HISTORY: |
| -- 30 Aug 95 SAIC Initial prerelease version. |
| -- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. |
| -- 26 Oct 96 SAIC Incorporated reviewer comments. |
| -- 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.Exceptions; |
| with Ada.Strings.Fixed; |
| with Impdef; |
| |
| procedure CXB30041 is |
| begin |
| |
| Report.Test ("CXB3004", "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; |
| use Ada.Exceptions; |
| use Ada.Strings.Fixed; |
| |
| Start_Character, |
| Stop_Character, |
| TC_Character : Character := Character'First; |
| TC_char, |
| TC_Low_char, |
| TC_High_char : char := char'First; |
| TC_String : String(1..8) := (others => Latin_1.NUL); |
| TC_char_array : char_array(0..7) := (others => C.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 char; |
| |
| -- 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.CXB30040_External_Name); |
| |
| begin |
| |
| -- Check that the functions To_C and To_Ada map between the Ada type |
| -- Character and the C type char. |
| |
| if To_C(Ada.Characters.Latin_1.NUL) /= Interfaces.C.nul then |
| Report.Failed("Incorrect result from To_C with NUL character input"); |
| end if; |
| |
| Start_Character := Report.Ident_Char('k'); |
| Stop_Character := Report.Ident_Char('t'); |
| for TC_Character in Start_Character..Stop_Character loop |
| if To_C(Item => TC_Character) /= |
| Char_Gen(Character'Pos(TC_Character) - Character'Pos('k') + 20) then |
| Report.Failed("Incorrect result from To_C with lower case " & |
| "alphabetic character input"); |
| end if; |
| end loop; |
| |
| Start_Character := Report.Ident_Char('A'); |
| Stop_Character := Report.Ident_Char('J'); |
| for TC_Character in Start_Character..Stop_Character loop |
| if To_C(Item => TC_Character) /= |
| Char_Gen(Character'Pos(TC_Character) - Character'Pos('A') + 10) then |
| Report.Failed("Incorrect result from To_C with upper case " & |
| "alphabetic character input"); |
| end if; |
| end loop; |
| |
| Start_Character := Report.Ident_Char('0'); |
| Stop_Character := Report.Ident_Char('9'); |
| for TC_Character in Start_Character..Stop_Character loop |
| if To_C(Item => TC_Character) /= |
| Char_Gen(Character'Pos(TC_Character) - Character'Pos('0')) then |
| Report.Failed("Incorrect result from To_C with digit " & |
| "character input"); |
| end if; |
| end loop; |
| if To_C(Item => ' ') /= Char_Gen(30) then |
| Report.Failed("Incorrect result from To_C with space " & |
| "character input"); |
| end if; |
| if To_C(Item => '.') /= Char_Gen(31) then |
| Report.Failed("Incorrect result from To_C with dot " & |
| "character input"); |
| end if; |
| if To_C(Item => ',') /= Char_Gen(32) then |
| Report.Failed("Incorrect result from To_C with comma " & |
| "character input"); |
| end if; |
| |
| if To_Ada(Interfaces.C.nul) /= Ada.Characters.Latin_1.NUL then |
| Report.Failed("Incorrect result from To_Ada with nul char 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)) /= |
| Character'Val (Character'Pos('k') + (Code - 20)) then |
| Report.Failed("Incorrect result from To_Ada with lower case " & |
| "alphabetic char 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)) /= |
| Character'Val (Character'Pos('A') + (Code - 10)) then |
| Report.Failed("Incorrect result from To_Ada with upper case " & |
| "alphabetic char 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)) /= |
| Character'Val (Character'Pos('0') + (Code)) then |
| Report.Failed("Incorrect result from To_Ada with digit " & |
| "char 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 char_array argument contains the |
| -- Ada.Interfaces.C.nul character. |
| |
| TC_String := "abcdefgh"; |
| if Is_Nul_Terminated(Item => To_C(TC_String, Append_Nul => False)) then |
| Report.Failed("Incorrect result from Is_Nul_Terminated when no " & |
| "nul char is present"); |
| end if; |
| |
| if not Is_Nul_Terminated(To_C(TC_String, Append_Nul => True)) then |
| Report.Failed("Incorrect result from Is_Nul_Terminated when the " & |
| "nul char 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_nul : constant char_array := To_C(TC_String, False); |
| TC_nul_Appended : constant char_array := To_C(TC_String, True); |
| begin |
| |
| -- Check that the function To_C produces a char_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_nul'First /= 0 or TC_nul_Appended'First /= 0 then |
| Report.Failed("Incorrect lower bound from Function To_C"); |
| end if; |
| |
| if TC_No_nul'Length /= TC_String'Length then |
| Report.Failed("Incorrect length returned from Function To_C " & |
| "when Append_Nul => False"); |
| end if; |
| |
| for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop |
| if TC_No_nul(i) /= To_C(TC_char) or -- Single character To_C. |
| TC_nul_Appended(i) /= To_C(TC_char) then |
| Incorrect_Conversion := True; |
| end if; |
| i := i + 1; |
| end loop; |
| |
| if Incorrect_Conversion then |
| Report.Failed("Incorrect result from To_C with string input " & |
| "and char_array result"); |
| end if; |
| |
| |
| if TC_nul_Appended'Length /= TC_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_nul_Appended) then |
| Report.Failed("No nul appended to the string parameter during " & |
| "conversion to char_array by function To_C"); |
| end if; |
| |
| |
| -- Check that the function To_Ada produces a 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 True, length will be the length of the slice of Item prior to |
| -- the first nul). |
| |
| declare |
| TC_No_NUL_String : constant String := |
| To_Ada(Item => TC_nul_Appended, |
| Trim_Nul => True); |
| TC_NUL_Appended_String : constant String := |
| To_Ada(TC_nul_Appended, False); |
| begin |
| |
| if TC_No_NUL_String'First /= 1 or |
| TC_NUL_Appended_String'First /= 1 |
| then |
| Report.Failed("Incorrect lower bound from Function To_Ada"); |
| end if; |
| |
| if TC_No_NUL_String'Length /= TC_String'Length then |
| Report.Failed("Incorrect length returned from Function " & |
| "To_Ada when Trim_Nul => True"); |
| end if; |
| |
| if TC_NUL_Appended_String'Length /= TC_String'Length + 1 then |
| Report.Failed("Incorrect length returned from Function " & |
| "To_Ada when Trim_Nul => False"); |
| end if; |
| |
| Start_Character := Report.Ident_Char('a'); |
| Stop_Character := Report.Ident_Char('h'); |
| for TC_Character in Start_Character..Stop_Character loop |
| if TC_No_NUL_String(j) /= TC_Character or |
| TC_NUL_Appended_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 nul char. |
| |
| begin |
| TC_String := To_Ada(TC_No_nul, Trim_Nul => True); |
| Report.Failed("Terminator_Error not raised when Item " & |
| "parameter of To_Ada does not contain the " & |
| "nul char, but parameter Trim_Nul => True"); |
| Report.Comment(TC_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 nul char, but parameter " & |
| "Trim_Nul => True"); |
| end; |
| |
| end; |
| |
| exception |
| when The_Error : others => |
| Report.Failed ("The following exception was raised in the " & |
| "Test_Block: " & Exception_Name(The_Error)); |
| end Test_Block; |
| |
| Report.Result; |
| |
| end CXB30041; |
