|
111
|
1 -- CXB3014.A
|
|
|
2 --
|
|
|
3 -- Grant of Unlimited Rights
|
|
|
4 --
|
|
|
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
|
|
|
14 -- to do so.
|
|
|
15 --
|
|
|
16 -- DISCLAIMER
|
|
|
17 --
|
|
|
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.
|
|
|
24 --*
|
|
|
25 --
|
|
|
26 -- OBJECTIVE:
|
|
|
27 -- Check that the Function Value with Pointer and Element
|
|
|
28 -- parameters will return an Element_Array result of correct size
|
|
|
29 -- and content (up to and including the first "terminator" Element).
|
|
|
30 --
|
|
|
31 -- Check that the Function Value with Pointer and Length parameters
|
|
|
32 -- will return an Element_Array result of appropriate size and content
|
|
|
33 -- (the first Length elements pointed to by the parameter Ref).
|
|
|
34 --
|
|
|
35 -- Check that both versions of Function Value will propagate
|
|
|
36 -- Interfaces.C.Strings.Dereference_Error when the value of
|
|
|
37 -- the Ref pointer parameter is null.
|
|
|
38 --
|
|
|
39 -- TEST DESCRIPTION:
|
|
|
40 -- This test tests that both versions of Function Value from the
|
|
|
41 -- generic package Interfaces.C.Pointers are available and produce
|
|
|
42 -- correct results. The generic package is instantiated with size_t,
|
|
|
43 -- char, char_array, and nul as actual parameters, and subtests are
|
|
|
44 -- performed on each of the Value functions resulting from this
|
|
|
45 -- instantiation.
|
|
|
46 -- For both function versions, a test is performed where a portion of
|
|
|
47 -- a char_array is to be returned as the function result. Likewise,
|
|
|
48 -- a test is performed where each version of the function returns the
|
|
|
49 -- entire char_array referenced by the in parameter Ref.
|
|
|
50 -- Finally, both versions of Function Value are called with a null
|
|
|
51 -- pointer reference, to ensure that Dereference_Error is raised in
|
|
|
52 -- this case.
|
|
|
53 --
|
|
|
54 -- This test assumes that the following characters are all included
|
|
|
55 -- in the implementation defined type Interfaces.C.char:
|
|
|
56 -- ' ', 'a'..'z', and 'A'..'Z'.
|
|
|
57 --
|
|
|
58 -- APPLICABILITY CRITERIA:
|
|
|
59 -- This test is applicable to all implementations that provide
|
|
|
60 -- packages Interfaces.C.Strings and Interfaces.C.Pointers. If an
|
|
|
61 -- implementation provides packages Interfaces.C.Strings and
|
|
|
62 -- Interfaces.C.Pointers, this test must compile, execute, and
|
|
|
63 -- report "PASSED".
|
|
|
64 --
|
|
|
65 --
|
|
|
66 -- CHANGE HISTORY:
|
|
|
67 -- 19 Oct 95 SAIC Initial prerelease version.
|
|
|
68 -- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
|
|
|
69 -- 23 Oct 96 SAIC Incorporated reviewer comments.
|
|
|
70 --
|
|
|
71 --!
|
|
|
72
|
|
|
73 with Report;
|
|
|
74 with Interfaces.C.Strings; -- N/A => ERROR
|
|
|
75 with Interfaces.C.Pointers; -- N/A => ERROR
|
|
|
76
|
|
|
77 procedure CXB3014 is
|
|
|
78
|
|
|
79 begin
|
|
|
80
|
|
|
81 Report.Test ("CXB3014", "Check that versions of the Value function " &
|
|
|
82 "from package Interfaces.C.Pointers produce " &
|
|
|
83 "correct results");
|
|
|
84
|
|
|
85 Test_Block:
|
|
|
86 declare
|
|
|
87
|
|
|
88 use type Interfaces.C.char, Interfaces.C.size_t;
|
|
|
89
|
|
|
90 Char_a : constant Interfaces.C.char := 'a';
|
|
|
91 Char_j : constant Interfaces.C.char := 'j';
|
|
|
92 Char_z : constant Interfaces.C.char := 'z';
|
|
|
93
|
|
|
94 subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z;
|
|
|
95 subtype Char_Range is Interfaces.C.size_t range 0..26;
|
|
|
96
|
|
|
97 Local_nul : aliased Interfaces.C.char := Interfaces.C.nul;
|
|
|
98 TC_Array_Size : Interfaces.C.size_t := 20;
|
|
|
99
|
|
|
100 TC_String_1 : constant String := "abcdefghij";
|
|
|
101 TC_String_2 : constant String := "abcdefghijklmnopqrstuvwxyz";
|
|
|
102 TC_String_3 : constant String := "abcdefghijklmnopqrst";
|
|
|
103 TC_String_4 : constant String := "abcdefghijklmnopqrstuvwxyz";
|
|
|
104 TC_Blank_String : constant String := " ";
|
|
|
105
|
|
|
106 TC_Char_Array : Interfaces.C.char_array(Char_Range) :=
|
|
|
107 Interfaces.C.To_C(TC_String_2, True);
|
|
|
108
|
|
|
109 TC_Char_Array_1 : Interfaces.C.char_array(0..9);
|
|
|
110 TC_Char_Array_2 : Interfaces.C.char_array(Char_Range);
|
|
|
111 TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1);
|
|
|
112 TC_Char_Array_4 : Interfaces.C.char_array(Char_Range);
|
|
|
113
|
|
|
114 package Char_Pointers is new
|
|
|
115 Interfaces.C.Pointers (Index => Interfaces.C.size_t,
|
|
|
116 Element => Interfaces.C.char,
|
|
|
117 Element_Array => Interfaces.C.char_array,
|
|
|
118 Default_Terminator => Interfaces.C.nul);
|
|
|
119
|
|
|
120 Char_Ptr : Char_Pointers.Pointer;
|
|
|
121
|
|
|
122 use type Char_Pointers.Pointer;
|
|
|
123
|
|
|
124 begin
|
|
|
125
|
|
|
126 -- Check that the Function Value with Pointer and Terminator Element
|
|
|
127 -- parameters will return an Element_Array result of appropriate size
|
|
|
128 -- and content (up to and including the first "terminator" Element.)
|
|
|
129
|
|
|
130 Char_Ptr := TC_Char_Array(0)'Access;
|
|
|
131
|
|
|
132 -- Provide a new Terminator char in the call of Function Value.
|
|
|
133 -- This call should return only a portion (the first 10 chars) of
|
|
|
134 -- the referenced char_array, up to and including the char 'j'.
|
|
|
135
|
|
|
136 TC_Char_Array_1 := Char_Pointers.Value(Ref => Char_Ptr,
|
|
|
137 Terminator => Char_j);
|
|
|
138
|
|
|
139 if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or
|
|
|
140 Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1)
|
|
|
141 then
|
|
|
142 Report.Failed("Incorrect result from Function Value with Ref " &
|
|
|
143 "and Terminator parameters, when supplied with " &
|
|
|
144 "a non-default Terminator char");
|
|
|
145 end if;
|
|
|
146
|
|
|
147 -- Use the default Terminator char in the call of Function Value.
|
|
|
148 -- This call should return the entire char_array, including the
|
|
|
149 -- terminating nul char.
|
|
|
150
|
|
|
151 TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr);
|
|
|
152
|
|
|
153 if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or
|
|
|
154 not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2)
|
|
|
155 then
|
|
|
156 Report.Failed("Incorrect result from Function Value with Ref " &
|
|
|
157 "and Terminator parameters, when using the " &
|
|
|
158 "default Terminator char");
|
|
|
159 end if;
|
|
|
160
|
|
|
161
|
|
|
162
|
|
|
163 -- Check that the Function Value with Pointer and Length parameters
|
|
|
164 -- will return an Element_Array result of appropriate size and content
|
|
|
165 -- (the first Length elements pointed to by the parameter Ref).
|
|
|
166
|
|
|
167 -- This call should return only a portion (the first 20 chars) of
|
|
|
168 -- the referenced char_array.
|
|
|
169
|
|
|
170 TC_Char_Array_3 :=
|
|
|
171 Char_Pointers.Value(Ref => Char_Ptr,
|
|
|
172 Length => Interfaces.C.ptrdiff_t(TC_Array_Size));
|
|
|
173
|
|
|
174 -- Verify the individual chars of the result.
|
|
|
175 for i in 0..TC_Array_Size-1 loop
|
|
|
176 if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /=
|
|
|
177 TC_String_3(Integer(i)+1)
|
|
|
178 then
|
|
|
179 Report.Failed("Incorrect result from Function Value with " &
|
|
|
180 "Ref and Length parameters, when specifying " &
|
|
|
181 "a length less than the full array size");
|
|
|
182 exit;
|
|
|
183 end if;
|
|
|
184 end loop;
|
|
|
185
|
|
|
186 -- This call should return the entire char_array, including the
|
|
|
187 -- terminating nul char.
|
|
|
188
|
|
|
189 TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27);
|
|
|
190
|
|
|
191 if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or
|
|
|
192 not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4)
|
|
|
193 then
|
|
|
194 Report.Failed("Incorrect result from Function Value with Ref " &
|
|
|
195 "and Length parameters, when specifying the " &
|
|
|
196 "entire array size");
|
|
|
197 end if;
|
|
|
198
|
|
|
199
|
|
|
200
|
|
|
201 -- Check that both of the above versions of Function Value will
|
|
|
202 -- propagate Interfaces.C.Strings.Dereference_Error when the value of
|
|
|
203 -- the Ref Pointer parameter is null.
|
|
|
204
|
|
|
205 Char_Ptr := null;
|
|
|
206
|
|
|
207 begin
|
|
|
208 TC_Char_Array_1 := Char_Pointers.Value(Ref => Char_Ptr,
|
|
|
209 Terminator => Char_j);
|
|
|
210 Report.Failed("Dereference_Error not raised by Function " &
|
|
|
211 "Value with Terminator parameter, when " &
|
|
|
212 "provided a null reference");
|
|
|
213 -- Call Report.Comment to ensure that the assignment to
|
|
|
214 -- TC_Char_Array_1 is not "dead", and therefore can not be
|
|
|
215 -- optimized away.
|
|
|
216 Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False));
|
|
|
217 exception
|
|
|
218 when Interfaces.C.Strings.Dereference_Error =>
|
|
|
219 null; -- OK, expected exception.
|
|
|
220 when others =>
|
|
|
221 Report.Failed("Incorrect exception raised by Function " &
|
|
|
222 "Value with Terminator parameter, when " &
|
|
|
223 "provided a null reference");
|
|
|
224 end;
|
|
|
225
|
|
|
226
|
|
|
227 begin
|
|
|
228 TC_Char_Array_3 :=
|
|
|
229 Char_Pointers.Value(Char_Ptr,
|
|
|
230 Interfaces.C.ptrdiff_t(TC_Array_Size));
|
|
|
231 Report.Failed("Dereference_Error not raised by Function " &
|
|
|
232 "Value with Length parameter, when provided " &
|
|
|
233 "a null reference");
|
|
|
234 -- Call Report.Comment to ensure that the assignment to
|
|
|
235 -- TC_Char_Array_3 is not "dead", and therefore can not be
|
|
|
236 -- optimized away.
|
|
|
237 Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False));
|
|
|
238 exception
|
|
|
239 when Interfaces.C.Strings.Dereference_Error =>
|
|
|
240 null; -- OK, expected exception.
|
|
|
241 when others =>
|
|
|
242 Report.Failed("Incorrect exception raised by Function " &
|
|
|
243 "Value with Length parameter, when " &
|
|
|
244 "provided a null reference");
|
|
|
245 end;
|
|
|
246
|
|
|
247
|
|
|
248 exception
|
|
|
249 when others => Report.Failed ("Exception raised in Test_Block");
|
|
|
250 end Test_Block;
|
|
|
251
|
|
|
252 Report.Result;
|
|
|
253
|
|
|
254 end CXB3014;
|
