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 procedure To_C converts the character elements of
28 -- a string parameter into char elements of the char_array parameter
29 -- Target, with nul termination if parameter Append_Nul is true.
31 -- Check that the out parameter Count of procedure To_C is set to the
32 -- appropriate value for both the nul/no nul terminated cases.
34 -- Check that Constraint_Error is propagated by procedure To_C if the
35 -- length of the char_array parameter Target is not sufficient to
36 -- hold the converted string value.
38 -- Check that the Procedure To_Ada converts char elements of the
39 -- char_array parameter Item to the corresponding character elements
40 -- of string out parameter Target.
42 -- Check that Constraint_Error is propagated by Procedure To_Ada if the
43 -- length of string parameter Target is not long enough to hold the
44 -- converted char_array value.
46 -- Check that Terminator_Error is propagated by Procedure To_Ada if the
47 -- parameter Trim_Nul is set to True, but the actual Item parameter
48 -- contains no nul char.
51 -- This test uses a variety of String, and char_array objects to test
52 -- versions of the To_C and To_Ada procedures.
54 -- This test assumes that the following characters are all included
55 -- in the implementation defined type Interfaces.C.char:
56 -- ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '-'.
58 -- APPLICABILITY CRITERIA:
59 -- This test is applicable to all implementations that provide
60 -- package Interfaces.C. If an implementation provides
61 -- package Interfaces.C, this test must compile, execute, and
65 -- 01 Sep 95 SAIC Initial prerelease version.
66 -- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
67 -- 26 Oct 96 SAIC Incorporated reviewer comments.
68 -- 14 Sep 99 RLB Removed incorrect and unnecessary
69 -- Unchecked_Conversion.
74 with Interfaces
.C
; -- N/A => ERROR
75 with Ada
.Characters
.Latin_1
;
77 with Ada
.Strings
.Fixed
;
82 Report
.Test
("CXB3005", "Check that the procedures To_C and To_Ada " &
83 "produce correct results");
87 use Interfaces
, Interfaces
.C
;
90 use Ada
.Strings
.Fixed
;
92 TC_Short_String
: String(1..4) := (others => 'x');
93 TC_String
: String(1..8) := (others => 'y');
94 TC_char_array
: char_array
(0..7) := (others => char
'Last);
95 TC_size_t_Count
: size_t
:= size_t
'First;
96 TC_Natural_Count
: Natural := Natural'First;
99 -- We can use the character forms of To_Ada and To_C here to check
100 -- the results; they were tested in CXB3004. We give them different
101 -- names to avoid confusion below.
103 function Character_to_char
(Source
: in Character) return char
105 function char_to_Character
(Source
: in char
) return Character
110 -- Check that the procedure To_C converts the character elements of
111 -- a string parameter into char elements of char_array out parameter
114 -- Case of nul termination.
116 TC_String
(1..6) := "abcdef";
118 To_C
(Item
=> TC_String
(1..6), -- Source slice of length 6.
119 Target
=> TC_char_array
, -- Length 8 will accommodate nul.
120 Count
=> TC_size_t_Count
,
123 -- Check that the out parameter Count is set to the appropriate value
124 -- for the nul terminated case.
126 if TC_size_t_Count
/= 7 then
127 Report
.Failed
("Incorrect setting of out parameter Count by " &
128 "Procedure To_C when Append_Nul => True");
131 for i
in 1..TC_size_t_Count
-1 loop
132 if char_to_Character
(TC_char_array
(i
-1)) /= TC_String
(Integer(i
))
134 Report
.Failed
("Incorrect result from Procedure To_C when " &
135 "checking individual char values, case of " &
136 "Append_Nul => True; " &
137 "char position = " & Integer'Image(Integer(i
)));
141 if not Is_Nul_Terminated
(TC_char_array
) then
142 Report
.Failed
("No nul char appended to the char_array result " &
143 "from Procedure To_C when Append_Nul => True");
146 if TC_char_array
(0..6) /= To_C
("abcdef", True) then
147 Report
.Failed
("Incorrect result from Procedure To_C when " &
148 "directly comparing char_array results, case " &
149 "of Append_Nul => True");
153 -- Check Procedure To_C with no nul termination.
155 TC_char_array
:= (others => Character_to_char
('M')); -- Reinitialize.
156 TC_String
(1..4) := "WXYZ";
158 To_C
(Item
=> TC_String
(1..4), -- Source slice of length 4.
159 Target
=> TC_char_array
,
160 Count
=> TC_size_t_Count
,
161 Append_Nul
=> False);
163 -- Check that the out parameter Count is set to the appropriate value
164 -- for the non-nul terminated case.
166 if TC_size_t_Count
/= 4 then
167 Report
.Failed
("Incorrect setting of out parameter Count by " &
168 "Procedure To_C when Append_Nul => False");
171 for i
in 1..TC_size_t_Count
loop
172 if char_to_Character
(TC_char_array
(i
-1)) /= TC_String
(Integer(i
))
174 Report
.Failed
("Incorrect result from Procedure To_C when " &
175 "checking individual char values, case of " &
176 "Append_Nul => False; " &
177 "char position = " & Integer'Image(Integer(i
)));
181 if Is_Nul_Terminated
(TC_char_array
) then
182 Report
.Failed
("The nul char was appended to the char_array " &
183 "result of Procedure To_C when Append_Nul => False");
186 if TC_char_array
(0..3) /= To_C
("WXYZ", False) then
187 Report
.Failed
("Incorrect result from Procedure To_C when " &
188 "directly comparing char_array results, case " &
189 "of Append_Nul => False");
194 -- Check that Constraint_Error is raised by procedure To_C if the
195 -- length of the target char_array parameter is not sufficient to
196 -- hold the converted string value (plus nul if Append_Nul is True).
199 To_C
("A string too long",
204 Report
.Failed
("Constraint_Error not raised when the Target " &
205 "parameter of Procedure To_C is not long enough " &
206 "to hold the converted string");
207 Report
.Comment
(char_to_Character
(TC_char_array
(0)) &
208 " printed to defeat optimization");
210 when Constraint_Error
=> null; -- OK, expected exception.
212 Report
.Failed
("Incorrect exception raised by Procedure " &
213 "To_C when the Target parameter is not long " &
214 "enough to contain the char_array result");
219 -- Check that the procedure To_Ada converts char elements of the
220 -- char_array parameter Item to the corresponding character elements
221 -- of string out parameter Target, with result string length based on
222 -- the Trim_Nul parameter.
224 -- Case of appended nul char on the char_array In parameter.
226 TC_char_array
:= To_C
("ACVC-95", Append_Nul
=> True); -- 8 total chars.
227 TC_String
:= (others => '*'); -- Reinitialize.
229 To_Ada
(Item
=> TC_char_array
,
231 Count
=> TC_Natural_Count
,
234 if TC_Natural_Count
/= 8 then
235 Report
.Failed
("Incorrect value returned in out parameter Count " &
236 "by Procedure To_Ada, case of Trim_Nul => False");
239 for i
in 1..TC_Natural_Count
loop
240 if Character_to_char
(TC_String
(i
)) /= TC_char_array
(size_t
(i
-1))
242 Report
.Failed
("Incorrect result from Procedure To_Ada when " &
243 "checking individual char values, case of " &
244 "Trim_Nul => False, when a nul is present in " &
245 "the char_array input parameter; " &
246 "position = " & Integer'Image(Integer(i
)));
250 if TC_String
(TC_Natural_Count
) /= Latin_1
.Nul
then
251 Report
.Failed
("Last character of String result of Procedure " &
252 "To_Ada is not Nul, even though a nul was present " &
253 "in the char_array argument, and the Trim_Nul " &
254 "parameter was set to False");
258 TC_char_array
(0..3) := To_C
("XYz", Append_Nul
=> True); -- 4 chars.
259 TC_String
:= (others => '*'); -- Reinit.
261 To_Ada
(Item
=> TC_char_array
,
263 Count
=> TC_Natural_Count
,
266 if TC_Natural_Count
/= 3 then
267 Report
.Failed
("Incorrect value returned in out parameter Count " &
268 "by Procedure To_Ada, case of Trim_Nul => True");
271 for i
in 1..TC_Natural_Count
loop
272 if Character_to_char
(TC_String
(i
)) /= TC_char_array
(size_t
(i
-1))
274 Report
.Failed
("Incorrect result from Procedure To_Ada when " &
275 "checking individual char values, case of " &
276 "Trim_Nul => True, when a nul is present in " &
277 "the char_array input parameter; " &
278 "position = " & Integer'Image(Integer(i
)));
282 if TC_String
(TC_Natural_Count
) = Latin_1
.Nul
then
283 Report
.Failed
("Last character of String result of Procedure " &
284 "To_Ada is Nul, even though the Trim_Nul " &
285 "parameter was set to True");
288 -- Check that TC_String(TC_Natural_Count+1) is unchanged by procedure
291 if TC_String
(TC_Natural_Count
+1) /= '*' then
292 Report
.Failed
("Incorrect modification to TC_String at position " &
293 Integer'Image(TC_Natural_Count
+1) & " expected = " &
294 "*, found = " & TC_String
(TC_Natural_Count
+1));
298 -- Case of no nul char being present in the char_array argument.
300 TC_char_array
:= To_C
("ABCDWXYZ", Append_Nul
=> False);
301 TC_String
:= (others => '*'); -- Reinitialize.
303 To_Ada
(Item
=> TC_char_array
,
305 Count
=> TC_Natural_Count
,
308 if TC_Natural_Count
/= 8 then
309 Report
.Failed
("Incorrect value returned in out parameter Count " &
310 "by Procedure To_Ada, case of Trim_Nul => False, " &
311 "with no nul char present in the parameter Item");
314 for i
in 1..TC_Natural_Count
loop
315 if Character_to_char
(TC_String
(i
)) /= TC_char_array
(size_t
(i
-1))
317 Report
.Failed
("Incorrect result from Procedure To_Ada when " &
318 "checking individual char values, case of " &
319 "Trim_Nul => False, when a nul is not present " &
320 "in the char_array input parameter; " &
321 "position = " & Integer'Image(Integer(i
)));
325 if TC_String
(TC_Natural_Count
) = Latin_1
.Nul
then
326 Report
.Failed
("Last character of String result of Procedure " &
327 "To_Ada is Nul, even though the nul char was " &
328 "not present in the parameter Item, with the " &
329 "parameter Trim_Nul => False");
334 -- Check that the Procedure To_Ada raises Terminator_Error if the
335 -- parameter Trim_Nul is set to True, but the actual Item parameter
336 -- does not contain the nul char.
339 TC_char_array
:= To_C
("ABCDWXYZ", Append_Nul
=> False);
340 TC_String
:= (others => '*');
342 To_Ada
(TC_char_array
,
344 Count
=> TC_Natural_Count
,
347 Report
.Failed
("Terminator_Error not raised when Item " &
348 "parameter of To_Ada does not contain the " &
349 "nul char, but parameter Trim_Nul => True");
350 Report
.Comment
(TC_String
& " printed to defeat optimization");
352 when Terminator_Error
=> null; -- OK, expected exception.
354 Report
.Failed
("Incorrect exception raised by Procedure " &
355 "To_Ada when the Item parameter does not " &
356 "contain the nul char, but parameter " &
362 -- Check that Constraint_Error is propagated by procedure To_Ada if the
363 -- length of string parameter Target is not long enough to hold the
364 -- converted char_array value (plus nul if Trim_Nul is False).
367 TC_char_array
(0..4) := To_C
("ABCD", Append_Nul
=> True);
369 To_Ada
(TC_char_array
(0..4), -- 4 chars plus nul char.
370 TC_Short_String
, -- Length of 4.
371 Count
=> TC_Natural_Count
,
374 Report
.Failed
("Constraint_Error not raised when string " &
375 "parameter Target of Procedure To_Ada is not " &
376 "long enough to hold the converted chars");
377 Report
.Comment
(TC_Short_String
& " printed to defeat optimization");
379 when Constraint_Error
=> null; -- OK, expected exception.
381 Report
.Failed
("Incorrect exception raised by Procedure " &
382 "To_Ada when string parameter Target is " &
383 "not long enough to hold the converted chars");
389 when The_Error
: others =>
390 Report
.Failed
("The following exception was raised in the " &
391 "Test_Block: " & Exception_Name
(The_Error
));