3 -- Grant of Unlimited Rights
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
27 -- Check that the specifications of the package Interfaces.C.Pointers
28 -- are available for use.
31 -- This test verifies that the types and subprograms specified for the
32 -- interface are present
34 -- APPLICABILITY CRITERIA:
35 -- If an implementation provides package Interfaces.C.Pointers, this
36 -- test must compile, execute, and report "PASSED".
40 -- 06 Dec 94 SAIC ACVC 2.0
41 -- 28 Feb 96 SAIC Added applicability criteria.
46 with Interfaces
.C
.Pointers
; -- N/A => ERROR
49 package C
renames Interfaces
.C
;
51 package Test_Ptrs
is new C
.Pointers
54 Element_Array
=> C
.Char_Array
,
55 Default_Terminator
=> C
.Nul
);
59 Report
.Test
("CXB3003", "Check the specification of Interfaces.C.Pointers");
62 declare -- encapsulate the test
64 TC_Int
: integer := 1;
66 -- Note: In all of the following the Pointers spec. being tested
67 -- is shown in comments
69 -- type Pointer is access all Element;
70 subtype TST_Pointer_Type
is Test_Ptrs
.Pointer
;
72 TST_Element
: C
.Char
:= C
.Char
'First;
73 TST_Pointer
: TST_Pointer_Type
:= null;
74 TST_Pointer_2
: TST_Pointer_Type
:= null;
75 TST_Array
: C
.char_array
(1..5);
76 TST_Index
: C
.ptrdiff_t
:= C
.ptrdiff_t
'First;
78 begin -- encapsulation
80 -- Arrange that the calls to the subprograms are compiled but
83 if not Report
.Equal
( TC_Int
, TC_Int
) then
86 -- function Value (Ref : in Pointer;
87 -- Terminator : in Element := Default_Terminator)
88 -- return Element_Array;
90 TST_Array
:= Test_Ptrs
.Value
( TST_Pointer
); -- default
91 TST_Array
:= Test_Ptrs
.Value
( TST_Pointer
, TST_Element
);
93 -- function Value (Ref : in Pointer; Length : in ptrdiff_t)
94 -- return Element_Array;
96 TST_Array
:= Test_Ptrs
.Value
(TST_Pointer
, TST_Index
);
99 -- -- C-style Pointer arithmetic
101 -- function "+" (Left : in Pointer; Right : in ptrdiff_t)
103 TST_Pointer
:= Test_Ptrs
."+" (TST_Pointer
, TST_Index
);
105 -- function "+" (Left : in Ptrdiff_T; Right : in Pointer)
107 TST_Pointer
:= Test_Ptrs
."+" (TST_Index
, TST_Pointer
);
109 -- function "-" (Left : in Pointer; Right : in ptrdiff_t)
111 TST_Pointer
:= Test_Ptrs
."-" (TST_Pointer
, TST_Index
);
113 -- function "-" (Left : in Pointer; Right : in Pointer)
115 TST_Index
:= Test_Ptrs
."-" (TST_Pointer
, TST_Pointer
);
117 -- procedure Increment (Ref : in out Pointer);
118 Test_Ptrs
.Increment
(TST_Pointer
);
120 -- procedure Decrement (Ref : in out Pointer);
121 Test_Ptrs
.Decrement
(TST_Pointer
);
123 -- function Virtual_Length
124 -- ( Ref : in Pointer;
125 -- Terminator : in Element := Default_Terminator)
127 TST_Index
:= Test_Ptrs
.Virtual_Length
(TST_Pointer
);
128 TST_Index
:= Test_Ptrs
.Virtual_Length
(TST_Pointer
, TST_Element
);
130 -- procedure Copy_Terminated_Array
131 -- (Source : in Pointer;
132 -- Target : in Pointer;
133 -- Limit : in ptrdiff_t := ptrdiff_t'Last;
134 -- Terminator : in Element := Default_Terminator);
136 Test_Ptrs
.Copy_Terminated_Array
(TST_Pointer
, TST_Pointer_2
);
138 Test_Ptrs
.Copy_Terminated_Array
(TST_Pointer
,
142 Test_Ptrs
.Copy_Terminated_Array
(TST_Pointer
,
148 -- procedure Copy_Array
149 -- (Source : in Pointer;
150 -- Target : in Pointer;
151 -- Length : in ptrdiff_t);
153 Test_Ptrs
.Copy_Array
(TST_Pointer
, TST_Pointer_2
, TST_Index
);
155 -- This is out of LRM order to avoid complaints from compilers
156 -- about inaccessible code
157 -- Pointer_Error : exception;
159 raise Test_Ptrs
.Pointer_Error
;
163 end; -- encapsulation