cxb3015.a

来自「用于进行gcc测试」· A 代码 · 共 521 行 · 第 1/2 页

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