|
111
|
1 -- CXB3007.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 procedure To_C converts the Wide_Character elements
|
|
|
28 -- of a Wide_String parameter into wchar_t elements of the wchar_array
|
|
|
29 -- parameter Target, with wide_nul termination if parameter Append_Nul
|
|
|
30 -- is true.
|
|
|
31 --
|
|
|
32 -- Check that the out parameter Count of procedure To_C is set to the
|
|
|
33 -- appropriate value for both the wide_nul/no wide_nul terminated cases.
|
|
|
34 --
|
|
|
35 -- Check that Constraint_Error is propagated by procedure To_C if the
|
|
|
36 -- length of the wchar_array parameter Target is not sufficient to
|
|
|
37 -- hold the converted Wide_String value.
|
|
|
38 --
|
|
|
39 -- Check that the Procedure To_Ada converts wchar_t elements of the
|
|
|
40 -- wchar_array parameter Item to the corresponding Wide_Character
|
|
|
41 -- elements of Wide_String out parameter Target.
|
|
|
42 --
|
|
|
43 -- Check that Constraint_Error is propagated by Procedure To_Ada if the
|
|
|
44 -- length of Wide_String parameter Target is not long enough to hold the
|
|
|
45 -- converted wchar_array value.
|
|
|
46 --
|
|
|
47 -- Check that Terminator_Error is propagated by Procedure To_Ada if the
|
|
|
48 -- parameter Trim_Nul is set to True, but the actual Item parameter
|
|
|
49 -- contains no wide_nul wchar_t.
|
|
|
50 --
|
|
|
51 -- TEST DESCRIPTION:
|
|
|
52 -- This test uses a variety of Wide_String, and wchar_array objects to
|
|
|
53 -- test versions of the To_C and To_Ada procedures.
|
|
|
54 --
|
|
|
55 -- This test assumes that the following characters are all included
|
|
|
56 -- in the implementation defined type Interfaces.C.wchar_t:
|
|
|
57 -- ' ', 'a'..'z', 'A'..'Z', and '-'.
|
|
|
58 --
|
|
|
59 -- APPLICABILITY CRITERIA:
|
|
|
60 -- This test is applicable to all implementations that provide
|
|
|
61 -- package Interfaces.C. If an implementation provides
|
|
|
62 -- package Interfaces.C, this test must compile, execute, and
|
|
|
63 -- report "PASSED".
|
|
|
64 --
|
|
|
65 -- CHANGE HISTORY:
|
|
|
66 -- 01 Sep 95 SAIC Initial prerelease version.
|
|
|
67 -- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
|
|
|
68 -- 26 Oct 96 SAIC Incorporated reviewer comments.
|
|
|
69 -- 14 Sep 99 RLB Removed incorrect and unnecessary
|
|
|
70 -- Unchecked_Conversion.
|
|
|
71 --
|
|
|
72 --!
|
|
|
73
|
|
|
74 with Report;
|
|
|
75 with Interfaces.C; -- N/A => ERROR
|
|
|
76 with Ada.Characters.Latin_1;
|
|
|
77 with Ada.Characters.Handling;
|
|
|
78 with Ada.Exceptions;
|
|
|
79 with Ada.Strings.Wide_Fixed;
|
|
|
80
|
|
|
81 procedure CXB3007 is
|
|
|
82 begin
|
|
|
83
|
|
|
84 Report.Test ("CXB3007", "Check that the procedures To_C and To_Ada " &
|
|
|
85 "for wide strings produce correct results");
|
|
|
86 Test_Block:
|
|
|
87 declare
|
|
|
88
|
|
|
89 use Interfaces, Interfaces.C;
|
|
|
90 use Ada.Characters, Ada.Characters.Handling;
|
|
|
91 use Ada.Exceptions;
|
|
|
92 use Ada.Strings.Wide_Fixed;
|
|
|
93
|
|
|
94 TC_Short_Wide_String : Wide_String(1..4) :=
|
|
|
95 (others => Wide_Character'First);
|
|
|
96 TC_Wide_String : Wide_String(1..8) :=
|
|
|
97 (others => Wide_Character'First);
|
|
|
98 TC_wchar_array : wchar_array(0..7) := (others => wchar_t'First);
|
|
|
99 TC_size_t_Count : size_t := size_t'First;
|
|
|
100 TC_Natural_Count : Natural := Natural'First;
|
|
|
101
|
|
|
102
|
|
|
103 -- We can use the wide character forms of To_Ada and To_C here to check
|
|
|
104 -- the results; they were tested in CXB3006. We give them different
|
|
|
105 -- names to avoid confusion below.
|
|
|
106
|
|
|
107 function Wide_Character_to_wchar_t (Source : in Wide_Character)
|
|
|
108 return wchar_t renames To_C;
|
|
|
109 function wchar_t_to_Wide_Character (Source : in wchar_t)
|
|
|
110 return Wide_Character renames To_Ada;
|
|
|
111
|
|
|
112 begin
|
|
|
113
|
|
|
114 -- Check that the procedure To_C converts the Wide_Character elements
|
|
|
115 -- of a Wide_String parameter into wchar_t elements of wchar_array out
|
|
|
116 -- parameter Target.
|
|
|
117 --
|
|
|
118 -- Case of wide_nul termination.
|
|
|
119
|
|
|
120 TC_Wide_String(1..6) := "abcdef";
|
|
|
121
|
|
|
122 To_C (Item => TC_Wide_String(1..6), -- Source slice of length 6.
|
|
|
123 Target => TC_wchar_array,
|
|
|
124 Count => TC_size_t_Count,
|
|
|
125 Append_Nul => True);
|
|
|
126
|
|
|
127 -- Check that the out parameter Count is set to the appropriate value
|
|
|
128 -- for the wide_nul terminated case.
|
|
|
129
|
|
|
130 if TC_size_t_Count /= 7 then
|
|
|
131 Report.Failed("Incorrect setting of out parameter Count by " &
|
|
|
132 "Procedure To_C when Append_Nul => True");
|
|
|
133 end if;
|
|
|
134
|
|
|
135 for i in 1..TC_size_t_Count-1 loop
|
|
|
136 if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
|
|
|
137 TC_Wide_String(Integer(i))
|
|
|
138 then
|
|
|
139 Report.Failed("Incorrect result from Procedure To_C when " &
|
|
|
140 "checking individual wchar_t values, case of " &
|
|
|
141 "Append_Nul => True; " &
|
|
|
142 "wchar_t position = " & Integer'Image(Integer(i)));
|
|
|
143 end if;
|
|
|
144 end loop;
|
|
|
145
|
|
|
146 if not Is_Nul_Terminated(TC_wchar_array) then
|
|
|
147 Report.Failed("No wide_nul wchar_t appended to the wchar_array " &
|
|
|
148 "result from Procedure To_C when Append_Nul => True");
|
|
|
149 end if;
|
|
|
150
|
|
|
151 if TC_wchar_array(0..6) /= To_C("abcdef", True) then
|
|
|
152 Report.Failed("Incorrect result from Procedure To_C when " &
|
|
|
153 "directly comparing wchar_array results, case " &
|
|
|
154 "of Append_Nul => True");
|
|
|
155 end if;
|
|
|
156
|
|
|
157
|
|
|
158 -- Check Procedure To_C with no wide_nul termination.
|
|
|
159
|
|
|
160 TC_wchar_array := (others => Wide_Character_to_wchar_t('M'));
|
|
|
161 TC_Wide_String(1..4) := "WXYZ";
|
|
|
162
|
|
|
163 To_C (Item => TC_Wide_String(1..4), -- Source slice of length 4.
|
|
|
164 Target => TC_wchar_array,
|
|
|
165 Count => TC_size_t_Count,
|
|
|
166 Append_Nul => False);
|
|
|
167
|
|
|
168 -- Check that the out parameter Count is set to the appropriate value
|
|
|
169 -- for the non-wide_nul terminated case.
|
|
|
170
|
|
|
171 if TC_size_t_Count /= 4 then
|
|
|
172 Report.Failed("Incorrect setting of out parameter Count by " &
|
|
|
173 "Procedure To_C when Append_Nul => False");
|
|
|
174 end if;
|
|
|
175
|
|
|
176 for i in 1..TC_size_t_Count loop
|
|
|
177 if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
|
|
|
178 TC_Wide_String(Integer(i))
|
|
|
179 then
|
|
|
180 Report.Failed("Incorrect result from Procedure To_C when " &
|
|
|
181 "checking individual wchar_t values, case of " &
|
|
|
182 "Append_Nul => False; " &
|
|
|
183 "wchar_t position = " & Integer'Image(Integer(i)));
|
|
|
184 end if;
|
|
|
185 end loop;
|
|
|
186
|
|
|
187 if Is_Nul_Terminated(TC_wchar_array) then
|
|
|
188 Report.Failed
|
|
|
189 ("The wide_nul wchar_t was appended to the wchar_array " &
|
|
|
190 "result of Procedure To_C when Append_Nul => False");
|
|
|
191 end if;
|
|
|
192
|
|
|
193 if TC_wchar_array(0..3) /= To_C("WXYZ", False) then
|
|
|
194 Report.Failed("Incorrect result from Procedure To_C when " &
|
|
|
195 "directly comparing wchar_array results, case " &
|
|
|
196 "of Append_Nul => False");
|
|
|
197 end if;
|
|
|
198
|
|
|
199
|
|
|
200
|
|
|
201 -- Check that Constraint_Error is raised by procedure To_C if the
|
|
|
202 -- length of the target wchar_array parameter is not sufficient to
|
|
|
203 -- hold the converted Wide_String value (plus wide_nul if Append_Nul
|
|
|
204 -- is True).
|
|
|
205
|
|
|
206 TC_wchar_array := (others => wchar_t'First);
|
|
|
207 begin
|
|
|
208 To_C("A string too long",
|
|
|
209 TC_wchar_array,
|
|
|
210 TC_size_t_Count,
|
|
|
211 Append_Nul => True);
|
|
|
212
|
|
|
213 Report.Failed("Constraint_Error not raised when the Target " &
|
|
|
214 "parameter of Procedure To_C is not long enough " &
|
|
|
215 "to hold the converted Wide_String");
|
|
|
216 Report.Comment
|
|
|
217 (To_Character(wchar_t_to_Wide_Character(TC_wchar_array(0))) &
|
|
|
218 " printed to defeat optimization");
|
|
|
219 exception
|
|
|
220 when Constraint_Error => null; -- OK, expected exception.
|
|
|
221 when others =>
|
|
|
222 Report.Failed("Incorrect exception raised by Procedure " &
|
|
|
223 "To_C when the Target parameter is not long " &
|
|
|
224 "enough to contain the wchar_array result");
|
|
|
225 end;
|
|
|
226
|
|
|
227
|
|
|
228
|
|
|
229 -- Check that the procedure To_Ada converts wchar_t elements of the
|
|
|
230 -- wchar_array parameter Item to the corresponding Wide_Character
|
|
|
231 -- elements of Wide_String out parameter Target, with result wide
|
|
|
232 -- string length based on the Trim_Nul parameter.
|
|
|
233 --
|
|
|
234 -- Case of appended wide_nul wchar_t on the wchar_array In parameter.
|
|
|
235
|
|
|
236 TC_wchar_array :=
|
|
|
237 To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
|
|
|
238
|
|
|
239 To_Ada (Item => TC_wchar_array,
|
|
|
240 Target => TC_Wide_String,
|
|
|
241 Count => TC_Natural_Count,
|
|
|
242 Trim_Nul => False);
|
|
|
243
|
|
|
244 if TC_Natural_Count /= 8 then
|
|
|
245 Report.Failed("Incorrect value returned in out parameter Count " &
|
|
|
246 "by Procedure To_Ada, case of Trim_Nul => False");
|
|
|
247 end if;
|
|
|
248
|
|
|
249 for i in 1..TC_Natural_Count loop
|
|
|
250 if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
|
|
|
251 TC_wchar_array(size_t(i-1))
|
|
|
252 then
|
|
|
253 Report.Failed("Incorrect result from Procedure To_Ada when " &
|
|
|
254 "checking individual wchar_t values, case of " &
|
|
|
255 "Trim_Nul => False, when a wide_nul is present " &
|
|
|
256 "in the wchar_array input parameter; " &
|
|
|
257 "position = " & Integer'Image(Integer(i)));
|
|
|
258 end if;
|
|
|
259 end loop;
|
|
|
260
|
|
|
261 if TC_Wide_String(TC_Natural_Count) /= To_Wide_Character(Latin_1.Nul)
|
|
|
262 then
|
|
|
263 Report.Failed("Last Wide_Character of Wide_String result of " &
|
|
|
264 "Procedure To_Ada is not Nul, even though a " &
|
|
|
265 "wide_nul was present in the wchar_array argument, " &
|
|
|
266 "and the Trim_Nul parameter was set to False");
|
|
|
267 end if;
|
|
|
268
|
|
|
269
|
|
|
270 TC_Wide_String := (others => Wide_Character'First);
|
|
|
271 TC_wchar_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
|
|
|
272
|
|
|
273 To_Ada (Item => TC_wchar_array,
|
|
|
274 Target => TC_Wide_String,
|
|
|
275 Count => TC_Natural_Count,
|
|
|
276 Trim_Nul => True);
|
|
|
277
|
|
|
278 if TC_Natural_Count /= 3 then
|
|
|
279 Report.Failed("Incorrect value returned in out parameter Count " &
|
|
|
280 "by Procedure To_Ada, case of Trim_Nul => True");
|
|
|
281 end if;
|
|
|
282
|
|
|
283 for i in 1..TC_Natural_Count loop
|
|
|
284 if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
|
|
|
285 TC_wchar_array(size_t(i-1))
|
|
|
286 then
|
|
|
287 Report.Failed("Incorrect result from Procedure To_Ada when " &
|
|
|
288 "checking individual wchar_t values, case of " &
|
|
|
289 "Trim_Nul => True, when a wide_nul is present " &
|
|
|
290 "in the wchar_array input parameter; " &
|
|
|
291 "position = " & Integer'Image(Integer(i)));
|
|
|
292 end if;
|
|
|
293 end loop;
|
|
|
294
|
|
|
295 if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
|
|
|
296 then
|
|
|
297 Report.Failed("Last Wide_Character of Wide_String result of " &
|
|
|
298 "Procedure To_Ada is Nul, even though the " &
|
|
|
299 "Trim_Nul parameter was set to True");
|
|
|
300 end if;
|
|
|
301
|
|
|
302 if TC_Wide_String(TC_Natural_Count+1) /= Wide_Character'First then
|
|
|
303 Report.Failed("Incorrect replacement from To_Ada");
|
|
|
304 end if;
|
|
|
305
|
|
|
306
|
|
|
307 -- Case of no wide_nul wchar_t present in the wchar_array argument.
|
|
|
308
|
|
|
309 TC_Wide_String := (others => Wide_Character'First);
|
|
|
310 TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
|
|
|
311
|
|
|
312 To_Ada (Item => TC_wchar_array,
|
|
|
313 Target => TC_Wide_String,
|
|
|
314 Count => TC_Natural_Count,
|
|
|
315 Trim_Nul => False);
|
|
|
316
|
|
|
317 if TC_Natural_Count /= 8 then
|
|
|
318 Report.Failed("Incorrect value returned in out parameter Count " &
|
|
|
319 "by Procedure To_Ada, case of Trim_Nul => False, " &
|
|
|
320 "with no wide_nul wchar_t present in the parameter " &
|
|
|
321 "Item");
|
|
|
322 end if;
|
|
|
323
|
|
|
324 for i in 1..TC_Natural_Count loop
|
|
|
325 if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
|
|
|
326 TC_wchar_array(size_t(i-1))
|
|
|
327 then
|
|
|
328 Report.Failed("Incorrect result from Procedure To_Ada when " &
|
|
|
329 "checking individual wchar_t values, case of " &
|
|
|
330 "Trim_Nul => False, when a wide_nul is not " &
|
|
|
331 "present in the wchar_array input parameter; " &
|
|
|
332 "position = " & Integer'Image(Integer(i)));
|
|
|
333 end if;
|
|
|
334 end loop;
|
|
|
335
|
|
|
336 if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
|
|
|
337 then
|
|
|
338 Report.Failed("Last Wide_Character of Wide_String result of " &
|
|
|
339 "Procedure To_Ada is Nul, even though the wide_nul " &
|
|
|
340 "wchar_t was not present in the parameter Item, " &
|
|
|
341 "with the parameter Trim_Nul => False");
|
|
|
342 end if;
|
|
|
343
|
|
|
344
|
|
|
345
|
|
|
346 -- Check that the Procedure To_Ada raises Terminator_Error if the
|
|
|
347 -- parameter Trim_Nul is set to True, but the actual Item parameter
|
|
|
348 -- does not contain the wide_nul wchar_t.
|
|
|
349
|
|
|
350 begin
|
|
|
351 TC_Wide_String := (others => Wide_Character'First);
|
|
|
352 TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
|
|
|
353
|
|
|
354 To_Ada(TC_wchar_array,
|
|
|
355 TC_Wide_String,
|
|
|
356 Count => TC_Natural_Count,
|
|
|
357 Trim_Nul => True);
|
|
|
358
|
|
|
359 Report.Failed("Terminator_Error not raised when Item " &
|
|
|
360 "parameter of To_Ada does not contain the " &
|
|
|
361 "wide_nul wchar_t, but parameter Trim_Nul => True");
|
|
|
362 Report.Comment(To_String(TC_Wide_String) &
|
|
|
363 " printed to defeat optimization");
|
|
|
364 exception
|
|
|
365 when Terminator_Error => null; -- OK, expected exception.
|
|
|
366 when others =>
|
|
|
367 Report.Failed("Incorrect exception raised by Procedure " &
|
|
|
368 "To_Ada when the Item parameter does not " &
|
|
|
369 "contain the wide_nul wchar_t, but parameter " &
|
|
|
370 "Trim_Nul => True");
|
|
|
371 end;
|
|
|
372
|
|
|
373
|
|
|
374
|
|
|
375 -- Check that Constraint_Error is propagated by procedure To_Ada if the
|
|
|
376 -- length of Wide_String parameter Target is not long enough to hold the
|
|
|
377 -- converted wchar_array value (plus wide_nul if Trim_Nul is False).
|
|
|
378
|
|
|
379 begin
|
|
|
380 TC_wchar_array(0..4) := To_C ("ABCD", Append_Nul => True);
|
|
|
381
|
|
|
382 To_Ada(TC_wchar_array(0..4),
|
|
|
383 TC_Short_Wide_String, -- Length of 4.
|
|
|
384 Count => TC_Natural_Count,
|
|
|
385 Trim_Nul => False);
|
|
|
386
|
|
|
387 Report.Failed("Constraint_Error not raised when Wide_String " &
|
|
|
388 "parameter Target of Procedure To_Ada is not " &
|
|
|
389 "long enough to hold the converted wchar_ts");
|
|
|
390 Report.Comment(To_String(TC_Short_Wide_String) &
|
|
|
391 " printed to defeat optimization");
|
|
|
392 exception
|
|
|
393 when Constraint_Error => null; -- OK, expected exception.
|
|
|
394 when others =>
|
|
|
395 Report.Failed("Incorrect exception raised by Procedure " &
|
|
|
396 "To_Ada when Wide_String parameter Target is " &
|
|
|
397 "not long enough to hold the converted wchar_ts");
|
|
|
398 end;
|
|
|
399
|
|
|
400 exception
|
|
|
401 when The_Error : others =>
|
|
|
402 Report.Failed ("The following exception was raised in the " &
|
|
|
403 "Test_Block: " & Exception_Name(The_Error));
|
|
|
404 end Test_Block;
|
|
|
405
|
|
|
406 Report.Result;
|
|
|
407
|
|
|
408 end CXB3007;
|
