diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxb/cxb30041.am')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxb/cxb30041.am | 377 |
1 files changed, 377 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am b/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am new file mode 100644 index 000000000..73b874e1f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am @@ -0,0 +1,377 @@ +-- 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; |