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 function To_Chars_Ptr will return a Null_Ptr value
28 -- when the parameter Item is null. If the parameter Item is not null,
29 -- and references a chars_array object that does contain the char nul,
30 -- and parameter Nul_Check is True, check that To_Chars_Ptr performs a
31 -- pointer conversion from char_array_access type to chars_ptr type.
32 -- Check that if parameter Item is not null, and references a
33 -- chars_array object that does not contain nul, and parameter Nul_Check
34 -- is True, the To_Chars_Ptr function will propagate Terminator_Error.
35 -- Check that if parameter Item is not null, and parameter Nul_Check
36 -- is False, check that To_Chars_Ptr performs a pointer conversion from
37 -- char_array_access type to chars_ptr type.
39 -- Check that the New_Char_Array function will return a chars_ptr type
40 -- pointer to an allocated object that has been initialized with
41 -- the value of parameter Chars.
43 -- Check that the function New_String returns a chars_ptr initialized
44 -- to a nul-terminated string having the value of the Str parameter.
47 -- This test uses a variety of of string, char_array,
48 -- char_array_access and char_ptr values in order to validate the
49 -- functions under test, and results are compared for both length
52 -- This test assumes that the following characters are all included
53 -- in the implementation defined type Interfaces.C.char:
54 -- ' ', 'a'..'z', and 'A'.. 'Z'.
56 -- APPLICABILITY CRITERIA:
57 -- This test is applicable to all implementations that provide
58 -- package Interfaces.C.Strings. If an implementation provides
59 -- package Interfaces.C.Strings, this test must compile, execute, and
64 -- 20 Sep 95 SAIC Initial prerelease version.
65 -- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
66 -- 01 DEC 97 EDS Remove incorrect block of code (previously
68 -- 14 Sep 99 RLB Added check for behavior of To_Chars_Ptr when
69 -- Nul_Check => False. (From Technical
74 with Interfaces
.C
.Strings
; -- N/A => ERROR
75 with Ada
.Characters
.Latin_1
;
77 with Ada
.Strings
.Fixed
;
82 Report
.Test
("CXB3009", "Check that functions To_Chars_Ptr, " &
83 "New_Chars_Array, and New_String produce " &
89 package IC
renames Interfaces
.C
;
90 package ICS
renames Interfaces
.C
.Strings
;
93 use type IC
.char_array
;
95 use type ICS
.chars_ptr
;
97 Null_Char_Array_Access
: constant ICS
.char_array_access
:= null;
99 Test_String
: constant String := "Test String";
100 String_With_nul
: String(1..6) := "Addnul";
101 String_Without_nul
: String(1..6) := "No nul";
103 Char_Array_With_nul
: IC
.char_array
(0..6) :=
104 IC
.To_C
(String_With_nul
, True);
105 Char_Array_Without_nul
: IC
.char_array
(0..5) :=
106 IC
.To_C
(String_Without_nul
, False);
107 Char_Array_W_nul_Ptr
: ICS
.char_array_access
:=
108 new IC
.char_array
'(Char_Array_With_nul);
109 Char_Array_WO_nul_Ptr : ICS.char_array_access :=
110 new IC.char_array'(Char_Array_Without_nul
);
112 TC_chars_ptr
: ICS
.chars_ptr
;
114 TC_size_t
: IC
.size_t
:= IC
.size_t
'First;
119 -- Check that the function To_Chars_Ptr will return a Null_Ptr value
120 -- when the parameter Item is null.
122 if ICS
.To_Chars_Ptr
(Item
=> Null_Char_Array_Access
,
123 Nul_Check
=> False) /= ICS
.Null_Ptr
or
124 ICS
.To_Chars_Ptr
(Null_Char_Array_Access
,
125 Nul_Check
=> True) /= ICS
.Null_Ptr
or
126 ICS
.To_Chars_Ptr
(Null_Char_Array_Access
) /= ICS
.Null_Ptr
128 Report
.Failed
("Incorrect result from function To_Chars_Ptr " &
129 "with parameter Item being a null value");
133 -- Check that if the parameter Item is not null, and references a
134 -- chars_array object that does contain the nul char, and parameter
135 -- Nul_Check is True, function To_Chars_Ptr performs a pointer
136 -- conversion from char_array_access type to chars_ptr type.
139 TC_chars_ptr
:= ICS
.To_Chars_Ptr
(Item
=> Char_Array_W_nul_Ptr
,
142 if ICS
.Value
(TC_chars_ptr
) /= String_With_nul
or
143 ICS
.Value
(TC_chars_ptr
) /= Char_Array_With_nul
145 Report
.Failed
("Incorrect result from function To_Chars_Ptr " &
146 "with parameter Item being non-null and " &
147 "containing the nul char");
150 when IC
.Terminator_Error
=>
151 Report
.Failed
("Terminator_Error raised during the validation " &
152 "of Function To_Chars_Ptr");
154 Report
.Failed
("Unexpected exception raised during the " &
155 "validation of Function To_Chars_Ptr");
158 -- Check that if parameter Item is not null, and references a
159 -- chars_array object that does not contain nul, and parameter
160 -- Nul_Check is True, the To_Chars_Ptr function will propagate
164 TC_chars_ptr
:= ICS
.To_Chars_Ptr
(Char_Array_WO_nul_Ptr
, True);
165 Report
.Failed
("Terminator_Error was not raised by function " &
166 "To_Chars_Ptr when given a parameter Item that " &
167 "is non-null, and does not contain the nul " &
168 "char, but parameter Nul_Check is True");
169 TC_size_t
:= ICS
.Strlen
(TC_chars_ptr
); -- Use TC_chars_ptr to
170 -- defeat optimization;
172 when IC
.Terminator_Error
=> null; -- Expected exception.
174 Report
.Failed
("Incorrect exception raised when function " &
175 "To_Chars_Ptr is given a parameter Item that " &
176 "is non-null, and does not contain the nul " &
177 "char, but parameter Nul_Check is True");
180 -- Check that if the parameter Item is not null, and parameter
181 -- Nul_Check is False, function To_Chars_Ptr performs a pointer
182 -- conversion from char_array_access type to chars_ptr type.
185 TC_chars_ptr
:= ICS
.To_Chars_Ptr
(Item
=> Char_Array_WO_nul_Ptr
,
188 if ICS
.Value
(TC_chars_ptr
, 6) /= String_Without_nul
or
189 ICS
.Value
(TC_chars_ptr
, 6) /= Char_Array_Without_nul
191 Report
.Failed
("Incorrect result from function To_Chars_Ptr " &
192 "with parameter Item being non-null and " &
196 when IC
.Terminator_Error
=>
197 Report
.Failed
("Terminator_Error raised during the validation " &
198 "of Function To_Chars_Ptr");
200 Report
.Failed
("Unexpected exception raised during the " &
201 "validation of Function To_Chars_Ptr");
205 -- Check that the New_Char_Array function will return a chars_ptr type
206 -- pointer to an allocated object that has been initialized with
207 -- the value of parameter Chars.
208 TC_chars_ptr
:= ICS
.New_String
("");
209 ICS
.Free
(TC_chars_ptr
); -- Reset the chars_ptr to Null_Ptr;
211 if TC_chars_ptr
/= ICS
.Null_Ptr
then
212 Report
.Failed
("Reset of TC_chars_ptr to Null not successful - 1");
215 TC_chars_ptr
:= ICS
.New_Char_Array
(Chars
=> Char_Array_With_nul
);
217 if TC_chars_ptr
= ICS
.Null_Ptr
then -- Check allocation.
219 ("No allocation took place in call to New_Char_Array " &
220 "with a non-null char_array parameter containing a " &
221 "terminating nul char");
224 -- Length of allocated array is determined using Strlen since array
225 -- is nul terminated. Contents of array are validated using Value.
227 if ICS
.Value
(TC_chars_ptr
, Length
=> 7) /= Char_Array_With_nul
or
228 ICS
.Strlen
(Item
=> TC_chars_ptr
) /= 6
231 ("Incorrect length of allocated char_array resulting " &
232 "from call of New_Char_Array with a non-null " &
233 "char_array parameter containing a terminating nul char");
236 ICS
.Free
(TC_chars_ptr
); -- Reset the chars_ptr to Null_Ptr;
237 if TC_chars_ptr
/= ICS
.Null_Ptr
then
238 Report
.Failed
("Reset of TC_chars_ptr to Null not successful - 2");
241 TC_chars_ptr
:= ICS
.New_Char_Array
(Chars
=> Char_Array_Without_nul
);
243 if TC_chars_ptr
= ICS
.Null_Ptr
then -- Check allocation.
245 ("No allocation took place in call to New_Char_Array " &
246 "with a non-null char_array parameter that did not " &
247 "contain a terminating nul char");
250 -- Function Value is used with the total length of the
251 -- Char_Array_Without_nul as a parameter to verify the allocation.
253 if ICS
.Value
(Item
=> TC_chars_ptr
, Length
=> 6) /=
254 Char_Array_Without_nul
or
255 ICS
.Strlen
(Item
=> TC_chars_ptr
) /= 6
257 Report
.Failed
("Incorrect length of allocated char_array " &
258 "resulting from call of New_Char_Array with " &
259 "a non-null char_array parameter that did not " &
260 "contain a terminating nul char");
264 -- Check that the function New_String returns a chars_ptr specifying
265 -- an allocated object initialized to the value of parameter Str.
267 ICS
.Free
(TC_chars_ptr
); -- Reset the chars_ptr to Null_Ptr;
268 if TC_chars_ptr
/= ICS
.Null_Ptr
then
269 Report
.Failed
("Reset of TC_chars_ptr to Null not successful - 3");
272 TC_chars_ptr
:= ICS
.New_String
(Str
=> Test_String
);
274 if ICS
.Value
(TC_chars_ptr
) /= Test_String
or
275 ICS
.Value
(ICS
.New_Char_Array
(IC
.To_C
(Test_String
,True))) /=
278 Report
.Failed
("Incorrect allocation resulting from function " &
279 "New_String with a string parameter value");
282 ICS
.Free
(TC_chars_ptr
); -- Reset the chars_ptr to Null_Ptr;
283 if TC_chars_ptr
/= ICS
.Null_Ptr
then
284 Report
.Failed
("Reset of TC_chars_ptr to Null not successful - 4");
287 if ICS
.Value
(ICS
.New_String
(String_Without_nul
)) /=
288 String_Without_nul
or
289 ICS
.Value
(ICS
.New_Char_Array
(IC
.To_C
(String_Without_nul
,False))) /=
292 Report
.Failed
("Incorrect allocation resulting from function " &
293 "New_String with parameter value String_Without_nul");
298 when The_Error
: others =>
299 Report
.Failed
("The following exception was raised in the " &
300 "Test_Block: " & Exception_Name
(The_Error
));