diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxb/cxb3014.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxb/cxb3014.a | 254 |
1 files changed, 0 insertions, 254 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a b/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a deleted file mode 100644 index a9b386ffcfd..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a +++ /dev/null @@ -1,254 +0,0 @@ --- CXB3014.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 Function Value with Pointer and Element --- parameters will return an Element_Array result of correct size --- and content (up to and including the first "terminator" Element). --- --- Check that the Function Value with Pointer and Length parameters --- will return an Element_Array result of appropriate size and content --- (the first Length elements pointed to by the parameter Ref). --- --- Check that both versions of Function Value will propagate --- Interfaces.C.Strings.Dereference_Error when the value of --- the Ref pointer parameter is null. --- --- TEST DESCRIPTION: --- This test tests that both versions of Function Value from the --- generic package Interfaces.C.Pointers are available and produce --- correct results. The generic package is instantiated with size_t, --- char, char_array, and nul as actual parameters, and subtests are --- performed on each of the Value functions resulting from this --- instantiation. --- For both function versions, a test is performed where a portion of --- a char_array is to be returned as the function result. Likewise, --- a test is performed where each version of the function returns the --- entire char_array referenced by the in parameter Ref. --- Finally, both versions of Function Value are called with a null --- pointer reference, to ensure that Dereference_Error is raised in --- this case. --- --- This test assumes that the following characters are all included --- in the implementation defined type Interfaces.C.char: --- ' ', 'a'..'z', and 'A'..'Z'. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations that provide --- packages Interfaces.C.Strings and Interfaces.C.Pointers. If an --- implementation provides packages Interfaces.C.Strings and --- Interfaces.C.Pointers, this test must compile, execute, and --- report "PASSED". --- --- --- CHANGE HISTORY: --- 19 Oct 95 SAIC Initial prerelease version. --- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 23 Oct 96 SAIC Incorporated reviewer comments. --- ---! - -with Report; -with Interfaces.C.Strings; -- N/A => ERROR -with Interfaces.C.Pointers; -- N/A => ERROR - -procedure CXB3014 is - -begin - - Report.Test ("CXB3014", "Check that versions of the Value function " & - "from package Interfaces.C.Pointers produce " & - "correct results"); - - Test_Block: - declare - - use type Interfaces.C.char, Interfaces.C.size_t; - - Char_a : constant Interfaces.C.char := 'a'; - Char_j : constant Interfaces.C.char := 'j'; - Char_z : constant Interfaces.C.char := 'z'; - - subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z; - subtype Char_Range is Interfaces.C.size_t range 0..26; - - Local_nul : aliased Interfaces.C.char := Interfaces.C.nul; - TC_Array_Size : Interfaces.C.size_t := 20; - - TC_String_1 : constant String := "abcdefghij"; - TC_String_2 : constant String := "abcdefghijklmnopqrstuvwxyz"; - TC_String_3 : constant String := "abcdefghijklmnopqrst"; - TC_String_4 : constant String := "abcdefghijklmnopqrstuvwxyz"; - TC_Blank_String : constant String := " "; - - TC_Char_Array : Interfaces.C.char_array(Char_Range) := - Interfaces.C.To_C(TC_String_2, True); - - TC_Char_Array_1 : Interfaces.C.char_array(0..9); - TC_Char_Array_2 : Interfaces.C.char_array(Char_Range); - TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1); - TC_Char_Array_4 : Interfaces.C.char_array(Char_Range); - - package Char_Pointers is new - Interfaces.C.Pointers (Index => Interfaces.C.size_t, - Element => Interfaces.C.char, - Element_Array => Interfaces.C.char_array, - Default_Terminator => Interfaces.C.nul); - - Char_Ptr : Char_Pointers.Pointer; - - use type Char_Pointers.Pointer; - - begin - - -- Check that the Function Value with Pointer and Terminator Element - -- parameters will return an Element_Array result of appropriate size - -- and content (up to and including the first "terminator" Element.) - - Char_Ptr := TC_Char_Array(0)'Access; - - -- Provide a new Terminator char in the call of Function Value. - -- This call should return only a portion (the first 10 chars) of - -- the referenced char_array, up to and including the char 'j'. - - TC_Char_Array_1 := Char_Pointers.Value(Ref => Char_Ptr, - Terminator => Char_j); - - if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or - Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1) - then - Report.Failed("Incorrect result from Function Value with Ref " & - "and Terminator parameters, when supplied with " & - "a non-default Terminator char"); - end if; - - -- Use the default Terminator char in the call of Function Value. - -- This call should return the entire char_array, including the - -- terminating nul char. - - TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr); - - if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or - not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2) - then - Report.Failed("Incorrect result from Function Value with Ref " & - "and Terminator parameters, when using the " & - "default Terminator char"); - end if; - - - - -- Check that the Function Value with Pointer and Length parameters - -- will return an Element_Array result of appropriate size and content - -- (the first Length elements pointed to by the parameter Ref). - - -- This call should return only a portion (the first 20 chars) of - -- the referenced char_array. - - TC_Char_Array_3 := - Char_Pointers.Value(Ref => Char_Ptr, - Length => Interfaces.C.ptrdiff_t(TC_Array_Size)); - - -- Verify the individual chars of the result. - for i in 0..TC_Array_Size-1 loop - if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /= - TC_String_3(Integer(i)+1) - then - Report.Failed("Incorrect result from Function Value with " & - "Ref and Length parameters, when specifying " & - "a length less than the full array size"); - exit; - end if; - end loop; - - -- This call should return the entire char_array, including the - -- terminating nul char. - - TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27); - - if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or - not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4) - then - Report.Failed("Incorrect result from Function Value with Ref " & - "and Length parameters, when specifying the " & - "entire array size"); - end if; - - - - -- Check that both of the above versions of Function Value will - -- propagate Interfaces.C.Strings.Dereference_Error when the value of - -- the Ref Pointer parameter is null. - - Char_Ptr := null; - - begin - TC_Char_Array_1 := Char_Pointers.Value(Ref => Char_Ptr, - Terminator => Char_j); - Report.Failed("Dereference_Error not raised by Function " & - "Value with Terminator parameter, when " & - "provided a null reference"); - -- Call Report.Comment to ensure that the assignment to - -- TC_Char_Array_1 is not "dead", and therefore can not be - -- optimized away. - Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False)); - exception - when Interfaces.C.Strings.Dereference_Error => - null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Function " & - "Value with Terminator parameter, when " & - "provided a null reference"); - end; - - - begin - TC_Char_Array_3 := - Char_Pointers.Value(Char_Ptr, - Interfaces.C.ptrdiff_t(TC_Array_Size)); - Report.Failed("Dereference_Error not raised by Function " & - "Value with Length parameter, when provided " & - "a null reference"); - -- Call Report.Comment to ensure that the assignment to - -- TC_Char_Array_3 is not "dead", and therefore can not be - -- optimized away. - Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False)); - exception - when Interfaces.C.Strings.Dereference_Error => - null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Function " & - "Value with Length parameter, when " & - "provided a null reference"); - end; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXB3014; |