diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxb/cxb3015.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxb/cxb3015.a | 520 |
1 files changed, 0 insertions, 520 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a b/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a deleted file mode 100644 index 24ec826fab9..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a +++ /dev/null @@ -1,520 +0,0 @@ --- CXB3015.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 "+" and "-" functions with Pointer and ptrdiff_t --- parameters that return Pointer values produce correct results, --- based on the size of the array elements. --- --- Check that the "-" function with two Pointer parameters that --- returns a ptrdiff_t type parameter produces correct results, --- based on the size of the array elements. --- --- Check that each of the "+" and "-" functions above will --- propagate Pointer_Error if a Pointer parameter is null. --- --- Check that the Increment and Decrement procedures provide the --- correct "pointer arithmetic" operations. --- --- TEST DESCRIPTION: --- This test checks that the functions "+" and "-", and the procedures --- Increment and Decrement in the generic package Interfaces.C.Pointers --- will allow the user to perform "pointer arithmetic" operations on --- Pointer values. --- Package Interfaces.C.Pointers is instantiated three times, for --- short values, chars, and arrays of arrays. Pointers from each --- instantiated package are then used to reference different elements --- of array objects. Pointer arithmetic operations are performed on --- these pointers, and the results of these operations are verified --- against expected pointer positions along the referenced arrays. --- The propagation of Pointer_Error is checked for when the function --- Pointer parameter is null. --- --- The following chart indicates the combinations of subprograms and --- parameter types used in this test. --- --- --- Short Char Array --- -------------------------- --- "+" Pointer, ptrdiff_t | X | | X | --- |--------------------------| --- "+" ptrdiff_t, Pointer | X | | X | --- |--------------------------| --- "-" Pointer, ptrdiff_t | | X | X | --- |--------------------------| --- "-" Pointer, Pointer | | X | X | --- |--------------------------| --- Increment (Pointer) | X | | X | --- |--------------------------| --- Decrement (Pointer) | X | | X | --- -------------------------- --- --- This test assumes that the following characters are all included --- in the implementation defined type Interfaces.C.char: --- ' ', and 'a'..'z'. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations that provide --- package Interfaces.C.Pointers. If an implementation provides --- package Interfaces.C.Pointers, this test must compile, execute, and --- report "PASSED". --- --- --- CHANGE HISTORY: --- 26 Oct 95 SAIC Initial prerelease version. --- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 26 Oct 96 SAIC Incorporated reviewer comments. --- 06 Mar 00 RLB Repaired so that array of arrays component --- type is statically constrained. (C does not have --- an analog to an array of dynamically constrained --- arrays.) - -with Report; -with Ada.Exceptions; -with Interfaces.C.Pointers; -- N/A => ERROR - -procedure CXB3015 is -begin - - Report.Test ("CXB3015", "Check that +, -, Increment, and Decrement " & - "subprograms in Package Interfaces.C.Pointers " & - "produce correct results"); - - Test_Block: - declare - - use Ada.Exceptions; - use type Interfaces.C.short; - use type Interfaces.C.size_t, Interfaces.C.ptrdiff_t; - use type Interfaces.C.char, Interfaces.C.char_array; - - TC_Count : Interfaces.C.size_t; - TC_Increment : Interfaces.C.ptrdiff_t; - TC_ptrdiff_t : Interfaces.C.ptrdiff_t; - TC_Short : Interfaces.C.short := 0; - TC_Verbose : Boolean := False; - Constant_Min_Array_Size : constant Interfaces.C.size_t := 0; - Constant_Max_Array_Size : constant Interfaces.C.size_t := 20; - Min_Array_Size : Interfaces.C.size_t := Interfaces.C.size_t( - Report.Ident_Int(Integer(Constant_Min_Array_Size))); - Max_Array_Size : Interfaces.C.size_t := Interfaces.C.size_t( - Report.Ident_Int(Integer(Constant_Max_Array_Size))); - Min_size_t, - Max_size_t : Interfaces.C.size_t; - Short_Terminator : Interfaces.C.short := Interfaces.C.short'Last; - Alphabet : constant String := "abcdefghijklmnopqrstuvwxyz"; - - - type Short_Array_Type is - array (Interfaces.C.size_t range <>) of aliased Interfaces.C.short; - - type Constrained_Array_Type is - array (Min_Array_Size..Max_Array_Size) of aliased Interfaces.C.short; - - type Static_Constrained_Array_Type is - array (Constant_Min_Array_Size .. Constant_Max_Array_Size) of - aliased Interfaces.C.short; - - type Array_of_Arrays_Type is - array (Interfaces.C.size_t range <>) of aliased - Static_Constrained_Array_Type; - - - Short_Array : Short_Array_Type(Min_Array_Size..Max_Array_Size); - - Constrained_Array : Constrained_Array_Type; - - Terminator_Array : Static_Constrained_Array_Type := - (others => Short_Terminator); - - Ch_Array : Interfaces.C.char_array - (0..Interfaces.C.size_t(Alphabet'Length)) := - Interfaces.C.To_C(Alphabet, True); - - Array_of_Arrays : Array_of_Arrays_Type - (Min_Array_Size..Max_Array_Size); - - - package Short_Pointers is new - Interfaces.C.Pointers (Index => Interfaces.C.size_t, - Element => Interfaces.C.short, - Element_Array => Short_Array_Type, - Default_Terminator => Short_Terminator); - - package Char_Pointers is new - Interfaces.C.Pointers (Interfaces.C.size_t, - Interfaces.C.char, - Element_Array => Interfaces.C.char_array, - Default_Terminator => Interfaces.C.nul); - - package Array_Pointers is new - Interfaces.C.Pointers (Interfaces.C.size_t, - Static_Constrained_Array_Type, - Array_of_Arrays_Type, - Terminator_Array); - - - use Short_Pointers, Char_Pointers, Array_Pointers; - - Short_Ptr : Short_Pointers.Pointer := Short_Array(0)'Access; - Char_Ptr : Char_Pointers.Pointer := Ch_Array(0)'Access; - Start_Char_Ptr : Char_Pointers.Pointer := Ch_Array(1)'Access; - End_Char_Ptr : Char_Pointers.Pointer := Ch_Array(10)'Access; - Array_Ptr : Array_Pointers.Pointer := Array_of_Arrays(0)'Access; - Start_Array_Ptr : Array_Pointers.Pointer := Array_of_Arrays(1)'Access; - End_Array_Ptr : Array_Pointers.Pointer := Array_of_Arrays(10)'Access; - - begin - - -- Provide initial values for the arrays that hold short int values. - - for i in Min_Array_Size..Max_Array_Size-1 loop - Short_Array(i) := Interfaces.C.short(i); - for j in Min_Array_Size..Max_Array_Size loop - -- Initialize this "array of arrays" so that element (i)(0) - -- is different for each value of i. - Array_of_Arrays(i)(j) := TC_Short; - TC_Short := TC_Short + 1; - end loop; - end loop; - - -- Set the final element of each array object to be the "terminator" - -- element used in the instantiations above. - - Short_Array(Max_Array_Size) := Short_Terminator; - Array_of_Arrays(Max_Array_Size) := Terminator_Array; - - -- Check starting pointer positions. - - if Short_Ptr.all /= 0 or - Char_Ptr.all /= Ch_Array(0) or - Array_Ptr.all /= Array_of_Arrays(0) - then - Report.Failed("Incorrect initial value for the first " & - "Short_Array, Ch_Array, or Array_of_Array values"); - end if; - - - -- Check that both versions of the "+" function with Pointer and - -- ptrdiff_t parameters, that return a Pointer value, produce correct - -- results, based on the size of the array elements. - - for i in Min_Array_Size + 1 .. Max_Array_Size loop - - if Integer(i)/2*2 /= Integer(i) then -- Odd numbered loops. - -- Pointer + ptrdiff_t, increment by 1. - Short_Ptr := Short_Ptr + 1; - else -- Even numbered loops. - -- ptrdiff_t + Pointer, increment by 1. - Short_Ptr := 1 + Short_Ptr; - end if; - - if Short_Ptr.all /= Short_Array(i) then - Report.Failed("Incorrect value returned following use " & - "of the function +, incrementing by 1, " & - "array position : " & Integer'Image(Integer(i))); - if not TC_Verbose then - exit; - end if; - end if; - end loop; - - Array_Ptr := Array_of_Arrays(Min_Array_Size)'Access; - TC_Count := Min_Array_Size; - TC_Increment := 3; - while TC_Count+Interfaces.C.size_t(TC_Increment) < Max_Array_Size loop - - if Integer(TC_Count)/2*2 /= Integer(TC_Count) then - -- Odd numbered loops. - -- Pointer + ptrdiff_t, increment by 3. - Array_Ptr := Array_Pointers."+"(Array_Ptr, TC_Increment); - else - -- Odd numbered loops. - -- ptrdiff_t + Pointer, increment by 3. - Array_Ptr := Array_Pointers."+"(Left => TC_Increment, - Right => Array_Ptr); - end if; - - if Array_Ptr.all /= - Array_of_Arrays(TC_Count+Interfaces.C.size_t(TC_Increment)) - then - Report.Failed("Incorrect value returned following use " & - "of the function +, incrementing by " & - Integer'Image(Integer(TC_Increment)) & - ", array position : " & - Integer'Image(Integer(TC_Count) + - Integer(TC_Increment))); - if not TC_Verbose then - exit; - end if; - end if; - - TC_Count := TC_Count + Interfaces.C.size_t(TC_Increment); - end loop; - - - - -- Check that the "-" function with Pointer and ptrdiff_t parameters, - -- that returns a Pointer result, produces correct results, based - -- on the size of the array elements. - - -- Set the pointer to the last element in the char_array, which is a - -- nul char. - Char_Ptr := Ch_Array(Interfaces.C.size_t(Alphabet'Length))'Access; - - if Char_Ptr.all /= Interfaces.C.nul then - Report.Failed("Incorrect initial value for the last " & - "Ch_Array value"); - end if; - - Min_size_t := 1; - Max_size_t := Interfaces.C.size_t(Alphabet'Length); - - for i in reverse Min_size_t..Max_size_t loop - - -- Subtract 1 from the pointer; it should now point to the previous - -- element in the array. - Char_Ptr := Char_Ptr - 1; - - if Char_Ptr.all /= Ch_Array(i-1) then - Report.Failed("Incorrect value returned following use " & - "of the function '-' with char element values, " & - "array position : " & Integer'Image(Integer(i-1))); - if not TC_Verbose then - exit; - end if; - end if; - end loop; - - Array_Ptr := Array_of_Arrays(Max_Array_Size)'Access; - TC_Count := Max_Array_Size; - TC_Increment := 3; - while TC_Count > Min_Array_Size+Interfaces.C.size_t(TC_Increment) loop - - -- Decrement the pointer by 3. - Array_Ptr := Array_Pointers."-"(Array_Ptr, Right => 3); - - if Array_Ptr.all /= - Array_of_Arrays(TC_Count - Interfaces.C.size_t(TC_Increment)) - then - Report.Failed("Incorrect value returned following use " & - "of the function -, decrementing by " & - Integer'Image(Integer(TC_Increment)) & - ", array position : " & - Integer'Image(Integer(TC_Count-3))); - if not TC_Verbose then - exit; - end if; - end if; - - TC_Count := TC_Count - Interfaces.C.size_t(TC_Increment); - end loop; - - - - -- Check that the "-" function with two Pointer parameters, that - -- returns a ptrdiff_t type result, produces correct results, - -- based on the size of the array elements. - - TC_ptrdiff_t := 9; - if Char_Pointers."-"(Left => End_Char_Ptr, - Right => Start_Char_Ptr) /= TC_ptrdiff_t - then - Report.Failed("Incorrect result from pointer-pointer " & - "subtraction - 1"); - end if; - - Start_Char_Ptr := Ch_Array(1)'Access; - End_Char_Ptr := Ch_Array(25)'Access; - - TC_ptrdiff_t := 24; - if Char_Pointers."-"(End_Char_Ptr, - Right => Start_Char_Ptr) /= TC_ptrdiff_t - then - Report.Failed("Incorrect result from pointer-pointer " & - "subtraction - 2"); - end if; - - TC_ptrdiff_t := 9; - if Array_Pointers."-"(End_Array_Ptr, - Start_Array_Ptr) /= TC_ptrdiff_t - then - Report.Failed("Incorrect result from pointer-pointer " & - "subtraction - 3"); - end if; - - Start_Array_Ptr := Array_of_Arrays(Min_Array_Size)'Access; - End_Array_Ptr := Array_of_Arrays(Max_Array_Size)'Access; - - TC_ptrdiff_t := Interfaces.C.ptrdiff_t(Max_Array_Size) - - Interfaces.C.ptrdiff_t(Min_Array_Size); - if End_Array_Ptr - Start_Array_Ptr /= TC_ptrdiff_t then - Report.Failed("Incorrect result from pointer-pointer " & - "subtraction - 4"); - end if; - - - - -- Check that the Increment procedure produces correct results, - -- based upon the size of the array elements. - - Short_Ptr := Short_Array(0)'Access; - - for i in Min_Array_Size + 1 .. Max_Array_Size loop - -- Increment the value of the Pointer; it should now point - -- to the next element in the array. - Increment(Ref => Short_Ptr); - - if Short_Ptr.all /= Short_Array(i) then - Report.Failed("Incorrect value returned following use " & - "of the Procedure Increment on pointer to an " & - "array of short values, array position : " & - Integer'Image(Integer(i))); - if not TC_Verbose then - exit; - end if; - end if; - end loop; - - Array_Ptr := Array_of_Arrays(0)'Access; - - for i in Min_Array_Size + 1 .. Max_Array_Size loop - -- Increment the value of the Pointer; it should now point - -- to the next element in the array. - Increment(Array_Ptr); - - if Array_Ptr.all /= Array_of_Arrays(i) then - Report.Failed("Incorrect value returned following use " & - "of the Procedure Increment on an array of " & - "arrays, array position : " & - Integer'Image(Integer(i))); - if not TC_Verbose then - exit; - end if; - end if; - end loop; - - - -- Check that the Decrement procedure produces correct results, - -- based upon the size of the array elements. - - Short_Ptr := Short_Array(Max_Array_Size)'Access; - - for i in reverse Min_Array_Size .. Max_Array_Size - 1 loop - -- Decrement the value of the Pointer; it should now point - -- to the previous element in the array. - Decrement(Ref => Short_Ptr); - - if Short_Ptr.all /= Short_Array(i) then - Report.Failed("Incorrect value returned following use " & - "of the Procedure Decrement on pointer to an " & - "array of short values, array position : " & - Integer'Image(Integer(i))); - if not TC_Verbose then - exit; - end if; - end if; - end loop; - - Array_Ptr := Array_of_Arrays(Max_Array_Size)'Access; - - for i in reverse Min_Array_Size .. Max_Array_Size - 1 loop - -- Decrement the value of the Pointer; it should now point - -- to the previous array element. - Decrement(Array_Ptr); - - if Array_Ptr.all /= Array_of_Arrays(i) then - Report.Failed("Incorrect value returned following use " & - "of the Procedure Decrement on an array of " & - "arrays, array position : " & - Integer'Image(Integer(i))); - if not TC_Verbose then - exit; - end if; - end if; - end loop; - - - - -- Check that each of the "+" and "-" functions above will - -- propagate Pointer_Error if a Pointer parameter is null. - - begin - Short_Ptr := null; - Short_Ptr := Short_Ptr + 4; - Report.Failed("Pointer_Error not raised by Function + when " & - "the Pointer parameter is null"); - if Short_Ptr /= null then -- To avoid optimization. - Report.Comment("This should never be printed"); - end if; - exception - when Short_Pointers.Pointer_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function + " & - "when the Pointer parameter is null"); - end; - - - begin - Char_Ptr := null; - Char_Ptr := Char_Ptr - 1; - Report.Failed("Pointer_Error not raised by Function - when " & - "the Pointer parameter is null"); - if Char_Ptr /= null then -- To avoid optimization. - Report.Comment("This should never be printed"); - end if; - exception - when Char_Pointers.Pointer_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function - " & - "when the Pointer parameter is null"); - end; - - - begin - Array_Ptr := null; - Decrement(Array_Ptr); - Report.Failed("Pointer_Error not raised by Procedure Decrement " & - "when the Pointer parameter is null"); - if Array_Ptr /= null then -- To avoid optimization. - Report.Comment("This should never be printed"); - end if; - exception - when Array_Pointers.Pointer_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Procedure " & - "Decrement when the Pointer parameter is null"); - 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 CXB3015; |