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 version of Function Value with a chars_ptr parameter
28 -- that returns a String result returns an Ada string containing the
29 -- characters pointed to by the chars_ptr parameter, up to (but not
30 -- including) the terminating nul.
32 -- Check that the version of Function Value with a chars_ptr parameter
33 -- and a size_t parameter that returns a String result returns the
35 -- 1) a String of the first size_t number of characters, or
36 -- 2) a String of characters up to (but not including) the
39 -- Check that the Function Strlen returns a size_t result that
40 -- corresponds to the number of chars in the array pointed to by Item,
41 -- up to but not including the terminating nul.
43 -- Check that both of the above versions of Function Value and
44 -- Function Strlen propagate Dereference_Error if the Item parameter
48 -- This test validates two versions of Function Value, and the Function
49 -- Strlen. A series of char_ptr values are provided as input, and
50 -- results are compared for length or content.
52 -- This test assumes that the following characters are all included
53 -- in the implementation defined type Interfaces.C.char:
54 -- ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*' and '.'.
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,
60 -- and report "PASSED".
64 -- 28 Sep 95 SAIC Initial prerelease version.
65 -- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
66 -- 26 Oct 96 SAIC Incorporated reviewer comments.
71 with Ada
.Characters
.Latin_1
;
72 with Interfaces
.C
.Strings
; -- N/A => ERROR
77 Report
.Test
("CXB3011", "Check that the two versions of Function Value " &
78 "returning a String result, and the Function " &
79 "Strlen, produce correct results");
84 package IC
renames Interfaces
.C
;
85 package ICS
renames Interfaces
.C
.Strings
;
86 package ACL1
renames Ada
.Characters
.Latin_1
;
88 use type IC
.char_array
;
90 use type ICS
.chars_ptr
;
92 Null_Char_Array_Access
: constant ICS
.char_array_access
:= null;
94 TC_String
: String(1..5) := (others => 'X');
95 TC_String_1
: constant String := "*.3*0";
96 TC_String_2
: constant String := "Two";
97 TC_String_3
: constant String := "Five5";
98 TC_Blank_String
: constant String(1..5) := (others => ' ');
100 TC_char_array
: IC
.char_array
:=
101 IC
.To_C
(TC_Blank_String
, True);
102 TC_char_array_1
: constant IC
.char_array
:=
103 IC
.To_C
(TC_String_1
, True);
104 TC_char_array_2
: constant IC
.char_array
:=
105 IC
.To_C
(TC_String_2
, True);
106 TC_char_array_3
: constant IC
.char_array
:=
107 IC
.To_C
(TC_String_3
, True);
108 TC_Blank_char_array
: constant IC
.char_array
:=
109 IC
.To_C
(TC_Blank_String
, True);
111 TC_chars_ptr
: ICS
.chars_ptr
:=
112 ICS
.New_Char_Array
(TC_Blank_char_array
);
114 TC_size_t
: IC
.size_t
:= IC
.size_t
'First;
119 -- Check that the version of Function Value with a chars_ptr parameter
120 -- that returns a String result returns an Ada string containing the
121 -- characters pointed to by the chars_ptr parameter, up to (but not
122 -- including) the terminating nul.
124 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array_1
);
125 TC_String
:= ICS
.Value
(Item
=> TC_chars_ptr
);
127 if TC_String
/= TC_String_1
or
128 TC_String
(TC_String
'Last) = ACL1
.NUL
130 Report
.Failed
("Incorrect result from Function Value - 1");
133 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array_2
);
135 if ICS
.Value
(Item
=> TC_chars_ptr
) /=
136 IC
.To_Ada
(ICS
.Value
(TC_chars_ptr
), Trim_Nul
=> True)
138 Report
.Failed
("Incorrect result from Function Value - 2");
141 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array_3
);
142 TC_String
:= ICS
.Value
(TC_chars_ptr
);
144 if TC_String
/= TC_String_3
or
145 TC_String
(TC_String
'Last) = ACL1
.NUL
147 Report
.Failed
("Incorrect result from Function Value - 3");
151 -- Check that the version of Function Value with a chars_ptr parameter
152 -- and a size_t parameter that returns a String result returns the
154 -- 1) a String of the first size_t number of characters, or
155 -- 2) a String of characters up to (but not including) the
159 -- Case 1 : Length parameter specifies a length shorter than total
162 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array_1
);
163 TC_String
:= "XXXXX"; -- Reinitialize all characters in string.
164 TC_String
(1..5) := ICS
.Value
(Item
=> TC_chars_ptr
, Length
=> 6);
166 if TC_String
(1..4) /= TC_String_1
(1..4) or
167 TC_String
(TC_String
'Last) = ACL1
.NUL
169 Report
.Failed
("Incorrect result from Function Value - 4");
172 -- Case 2 : Length parameter specifies total length.
174 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array_2
);
176 if ICS
.Value
(TC_chars_ptr
, Length
=> 5) /=
177 IC
.To_Ada
(ICS
.Value
(TC_chars_ptr
), Trim_Nul
=> True)
179 Report
.Failed
("Incorrect result from Function Value - 5");
182 -- Case 3 : Length parameter specifies a length longer than total
185 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array_3
);
186 TC_String
:= "XXXXX"; -- Reinitialize all characters in string.
187 TC_String
:= ICS
.Value
(TC_chars_ptr
, 7);
189 if TC_String
/= TC_String_3
or
190 TC_String
(TC_String
'Last) = ACL1
.NUL
192 Report
.Failed
("Incorrect result from Function Value - 6");
196 -- Check that the Function Strlen returns a size_t result that
197 -- corresponds to the number of chars in the array pointed to by
198 -- parameter Item, up to but not including the terminating nul.
200 TC_chars_ptr
:= ICS
.New_Char_Array
(IC
.To_C
("A longer string value"));
201 TC_size_t
:= ICS
.Strlen
(TC_chars_ptr
);
203 if TC_size_t
/= 21 then
204 Report
.Failed
("Incorrect result from Function Strlen - 1");
207 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array_2
);
208 TC_size_t
:= ICS
.Strlen
(TC_chars_ptr
);
210 if TC_size_t
/= 3 then -- Nul not included in length.
211 Report
.Failed
("Incorrect result from Function Strlen - 2");
214 TC_chars_ptr
:= ICS
.New_Char_Array
(IC
.To_C
(""));
215 TC_size_t
:= ICS
.Strlen
(TC_chars_ptr
);
217 if TC_size_t
/= 0 then
218 Report
.Failed
("Incorrect result from Function Strlen - 3");
222 -- Check that both of the above versions of Function Value and
223 -- function Strlen propagate Dereference_Error if the Item parameter
227 TC_chars_ptr
:= ICS
.Null_Ptr
;
228 TC_String
:= ICS
.Value
(Item
=> TC_chars_ptr
);
229 Report
.Failed
("Function Value (without Length parameter) did not " &
230 "raise Dereference_Error when provided a null Item " &
231 "parameter input value");
232 if TC_String
(1) = '1' then -- Defeat optimization.
233 Report
.Comment
("Should never be printed");
236 when ICS
.Dereference_Error
=> null; -- OK, expected exception.
238 Report
.Failed
("Incorrect exception raised by Function Value " &
239 "with Item parameter, when the Item parameter " &
244 TC_chars_ptr
:= ICS
.Null_Ptr
;
245 TC_String
:= ICS
.Value
(Item
=> TC_chars_ptr
, Length
=> 4);
246 Report
.Failed
("Function Value (with Length parameter) did not " &
247 "raise Dereference_Error when provided a null Item " &
248 "parameter input value");
249 if TC_String
(1) = '1' then -- Defeat optimization.
250 Report
.Comment
("Should never be printed");
253 when ICS
.Dereference_Error
=> null; -- OK, expected exception.
255 Report
.Failed
("Incorrect exception raised by Function Value " &
256 "with both Item and Length parameters, when " &
257 "the Item parameter is Null_Ptr");
261 TC_chars_ptr
:= ICS
.Null_Ptr
;
262 TC_size_t
:= ICS
.Strlen
(Item
=> TC_chars_ptr
);
263 Report
.Failed
("Function Strlen did not raise Dereference_Error" &
264 "when provided a null Item parameter input value");
265 if TC_size_t
= 35 then -- Defeat optimization.
266 Report
.Comment
("Should never be printed");
269 when ICS
.Dereference_Error
=> null; -- OK, expected exception.
271 Report
.Failed
("Incorrect exception raised by Function Strlen " &
272 "when the Item parameter is Null_Ptr");
277 when others => Report
.Failed
("Exception raised in Test_Block");