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