Subversion Repositories openrisc_me

-- CXB3003.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 specifications of the package Interfaces.C.Pointers

--      are available for use.

--

-- TEST DESCRIPTION:

--      This test verifies that the types and subprograms specified for the

--      interface are present

--

-- APPLICABILITY CRITERIA:

--      If an implementation provides package Interfaces.C.Pointers, this

--      test must compile, execute, and report "PASSED".

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--      28 Feb 96   SAIC    Added applicability criteria.

--

--!

with Report;

with Interfaces.C.Pointers;                                   -- N/A => ERROR

procedure CXB3003 is

   package C renames Interfaces.C;

   package Test_Ptrs is new C.Pointers

                        (Index               => C.size_t,

                         Element             => C.Char,

                         Element_Array       => C.Char_Array,

                         Default_Terminator  => C.Nul);

begin

   Report.Test ("CXB3003", "Check the specification of Interfaces.C.Pointers");

   declare  -- encapsulate the test

      TC_Int        : integer := 1;

      --  Note:  In all of the following the Pointers spec. being tested

      --  is shown in comments

      --

      --    type Pointer is access all Element;

      subtype TST_Pointer_Type is Test_Ptrs.Pointer;

      TST_Element   : C.Char           := C.Char'First;

      TST_Pointer   : TST_Pointer_Type := null;

      TST_Pointer_2 : TST_Pointer_Type := null;

      TST_Array     : C.char_array (1..5);

      TST_Index     : C.ptrdiff_t      := C.ptrdiff_t'First;

   begin    -- encapsulation

      -- Arrange that the calls to the subprograms are compiled but

      -- not executed

      --

      if not Report.Equal ( TC_Int, TC_Int ) then

         --    function Value (Ref        : in Pointer;

         --                    Terminator : in Element := Default_Terminator)

         --      return Element_Array;

         TST_Array := Test_Ptrs.Value ( TST_Pointer );  -- default

         TST_Array := Test_Ptrs.Value ( TST_Pointer, TST_Element );

         --    function Value (Ref    : in Pointer; Length : in ptrdiff_t)

         --      return Element_Array;

         TST_Array := Test_Ptrs.Value (TST_Pointer, TST_Index);

         --

         --    --  C-style Pointer arithmetic

         --

         --    function "+" (Left : in Pointer;   Right : in ptrdiff_t)

         --                                                 return Pointer;

         TST_Pointer := Test_Ptrs."+" (TST_Pointer, TST_Index);

         --    function "+" (Left : in Ptrdiff_T; Right : in Pointer)

         --                                                 return Pointer;

         TST_Pointer := Test_Ptrs."+" (TST_Index, TST_Pointer);

         --    function "-" (Left : in Pointer;   Right : in ptrdiff_t)

         --                                                 return Pointer;

         TST_Pointer := Test_Ptrs."-" (TST_Pointer, TST_Index);

         --    function "-" (Left : in Pointer;   Right : in Pointer)

         --                                                 return ptrdiff_t;

         TST_Index  := Test_Ptrs."-" (TST_Pointer, TST_Pointer);

         --    procedure Increment (Ref : in out Pointer);

         Test_Ptrs.Increment (TST_Pointer);

         --    procedure Decrement (Ref : in out Pointer);

         Test_Ptrs.Decrement (TST_Pointer);

         --    function Virtual_Length

         --                 ( Ref        : in Pointer;

         --                   Terminator : in Element := Default_Terminator)

         --      return ptrdiff_t;

         TST_Index := Test_Ptrs.Virtual_Length (TST_Pointer);

         TST_Index := Test_Ptrs.Virtual_Length (TST_Pointer, TST_Element);

         --    procedure Copy_Terminated_Array

         --      (Source     : in Pointer;

         --       Target     : in Pointer;

         --       Limit      : in ptrdiff_t := ptrdiff_t'Last;

         --       Terminator : in Element := Default_Terminator);

         Test_Ptrs.Copy_Terminated_Array (TST_Pointer, TST_Pointer_2);

         Test_Ptrs.Copy_Terminated_Array (TST_Pointer,

                                          TST_Pointer_2,

                                          TST_Index);

         Test_Ptrs.Copy_Terminated_Array (TST_Pointer,

                                          TST_Pointer_2,

                                          TST_Index,

                                          TST_Element);

         --    procedure Copy_Array

         --      (Source  : in Pointer;

         --       Target  : in Pointer;

         --       Length  : in ptrdiff_t);

         Test_Ptrs.Copy_Array (TST_Pointer, TST_Pointer_2, TST_Index);

         --    This is out of LRM order to avoid complaints from compilers

         --    about inaccessible code

         --       Pointer_Error : exception;

         raise Test_Ptrs.Pointer_Error;

      end if;

   end;     -- encapsulation

   Report.Result;

end CXB3003;