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 Procedure Update modifies the value pointed to by
28 -- the chars_ptr parameter Item, starting at the position
29 -- corresponding to parameter Offset, using the chars in
30 -- char_array parameter Chars.
32 -- Check that the version of Procedure Update with a String parameter
33 -- behaves in the manner described above, but with the character
34 -- values in the String overwriting the char values in Item.
36 -- Check that both of the above versions of Procedure Update will
37 -- propagate Update_Error if Check is True, and if the length of
38 -- the new chars in Chars, when overlaid starting from position
39 -- Offset, will overwrite the first nul in Item.
42 -- This test checks two versions of Procedure Update. In the first
43 -- version of the procedure, the parameter Chars indicates a char_array
44 -- argument. These char_array parameters are provided through the use
45 -- of the To_C function (with String IN parameter), both with and
46 -- without a terminating nul. In the case below where a terminating nul
47 -- char is appended, the effect of "updating" the value pointed to by the
48 -- Item parameter will include its shortening, due to the insertion of
49 -- this additional nul in the middle of the char_array.
51 -- In the second version of Procedure Update evaluated here, the string
52 -- parameter Str is used to modify the char_array pointed to by Item.
54 -- Finally, both versions of the procedure are evaluated to ensure that
55 -- they propagate Update_Error and Dereference_Error under the proper
58 -- This test assumes that the following characters are all included
59 -- in the implementation defined type Interfaces.C.char:
60 -- ' ', 'a'..'z', 'A'..'Z', '0'..'9', '-' and '.'.
62 -- APPLICABILITY CRITERIA:
63 -- This test is applicable to all implementations that provide
64 -- package Interfaces.C.Strings. If an implementation provides
65 -- package Interfaces.C.Strings, this test must compile, execute,
66 -- and report "PASSED".
70 -- 05 Oct 95 SAIC Initial prerelease version.
71 -- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
72 -- 26 Oct 96 SAIC Incorporated reviewer comments.
73 -- 14 Sep 99 RLB Removed incorrect and unnecessary
74 -- Unchecked_Conversion. Added check for raising
75 -- of Dereference_Error for Update (From Technical
77 -- 07 Jan 05 RLB Modified to reflect change to Update by AI-242
78 -- (which is expected to be part of Amendment 1).
79 -- [This version allows either semantics.]
85 with Interfaces
.C
.Strings
; -- N/A => ERROR
90 Report
.Test
("CXB3012", "Check that both versions of Procedure Update " &
91 "produce correct results");
96 package IC
renames Interfaces
.C
;
97 package ICS
renames Interfaces
.C
.Strings
;
101 use type IC
.char_array
;
103 use type ICS
.chars_ptr
;
105 TC_String_1
: String(1..1) := "J";
106 TC_String_2
: String(1..2) := "Ab";
107 TC_String_3
: String(1..3) := "xyz";
108 TC_String_4
: String(1..4) := "ACVC";
109 TC_String_5
: String(1..5) := "1a2b3";
110 TC_String_6
: String(1..6) := "---...";
111 TC_String_7
: String(1..7) := "AABBBAA";
112 TC_String_8
: String(1..8) := "aBcDeFgH";
113 TC_String_9
: String(1..9) := "JustATest";
114 TC_String_10
: String(1..10) := "0123456789";
116 TC_Result_String_1
: constant String := "JXXXXXXXXX";
117 TC_Result_String_2
: constant String := "XXXXXXXXAb";
118 TC_Result_String_3
: constant String := "XXXxyz";
119 TC_Result_String_4
: constant String := "XACVC";
120 TC_Result_String_5
: constant String := "1a2b3";
121 TC_Result_String_6
: constant String := "XXX---...";
123 TC_Amd_Result_String_4
:
124 constant String := "XACVCXXXXX";
125 TC_Amd_Result_String_5
:
126 constant String := "1a2b3XXXXX";
127 TC_Amd_Result_String_6
:
128 constant String := "XXX---...X";
129 TC_Amd_Result_String_9
:
130 constant String := "JustATestX";
132 TC_char_array
: IC
.char_array
(0..10) := IC
.To_C
("XXXXXXXXXX");
133 TC_Result_char_array
: IC
.char_array
(0..10) := IC
.To_C
("XXXXXXXXXX");
134 TC_chars_ptr
: ICS
.chars_ptr
;
135 TC_Length
: IC
.size_t
;
139 -- Check that Procedure Update modifies the value pointed to by
140 -- the chars_ptr parameter Item, starting at the position
141 -- corresponding to parameter Offset, using the chars in
142 -- char_array parameter Chars.
143 -- Note: If parameter Chars contains a nul char (such as a
144 -- terminating nul), the result may be the overall shortening
145 -- of parameter Item.
147 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
149 ICS
.Update
(Item
=> TC_chars_ptr
,
151 Chars
=> IC
.To_C
(TC_String_1
, False), -- No nul char.
154 if ICS
.Value
(TC_chars_ptr
) /= TC_Result_String_1
then
155 Report
.Failed
("Incorrect result from Procedure Update - 1");
157 ICS
.Free
(TC_chars_ptr
);
160 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
161 ICS
.Update
(TC_chars_ptr
,
162 Offset
=> ICS
.Strlen
(TC_chars_ptr
) - 2,
163 Chars
=> IC
.To_C
(TC_String_2
, False), -- No nul char.
166 if ICS
.Value
(TC_chars_ptr
) /= TC_Result_String_2
then
167 Report
.Failed
("Incorrect result from Procedure Update - 2");
169 ICS
.Free
(TC_chars_ptr
);
172 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
173 ICS
.Update
(TC_chars_ptr
,
175 Chars
=> IC
.To_C
(TC_String_3
), -- Nul appended, shortens
176 Check
=> False); -- array.
178 if ICS
.Value
(TC_chars_ptr
) /= TC_Result_String_3
then
179 Report
.Failed
("Incorrect result from Procedure Update - 3");
181 ICS
.Free
(TC_chars_ptr
);
184 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
185 ICS
.Update
(TC_chars_ptr
,
187 IC
.To_C
(TC_String_10
), -- Complete replacement of array.
190 if ICS
.Value
(TC_chars_ptr
) /= TC_String_10
then
191 Report
.Failed
("Incorrect result from Procedure Update - 4");
194 -- Perform a character-by-character comparison of the result of
195 -- Procedure Update. Note that char_array lower bound is 0, and
196 -- that the nul char is not compared with any character in the
197 -- string (since the string is not nul terminated).
199 TC_Length
:= ICS
.Strlen
(TC_chars_ptr
);
200 TC_Result_char_array
(0..10) := ICS
.Value
(TC_chars_ptr
);
201 for i
in 0..TC_Length
-1 loop
202 if TC_Result_char_array
(i
) /=
203 IC
.To_C
(TC_String_10
(Integer(i
+1)))
205 Report
.Failed
("Incorrect result from the character-by-" &
206 "character evaluation of the result of " &
212 Report
.Failed
("Exception raised during the character-by-" &
213 "character evaluation of the result of " &
216 ICS
.Free
(TC_chars_ptr
);
220 -- Check that the version of Procedure Update with a String rather
221 -- than a char_array parameter behaves in the manner described above,
222 -- but with the character values in the String overwriting the char
225 -- Note: In Ada 95, In each of the cases below, the String parameter
226 -- Str is treated as if it were nul terminated, which means that
227 -- the char_array pointed to by TC_chars_ptr will be "shortened"
228 -- so that it ends after the last character of the Str
229 -- parameter. For Ada 2005, this rule is dropped, so the
230 -- number of characters remains the same.
232 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
233 ICS
.Update
(TC_chars_ptr
, 1, TC_String_4
, False);
235 if ICS
.Value
(TC_chars_ptr
) = TC_Result_String_4
then
236 Report
.Comment
("Ada 95 result from Procedure Update - 5");
237 elsif ICS
.Value
(TC_chars_ptr
) = TC_Amd_Result_String_4
then
238 Report
.Comment
("Amendment 1 result from Procedure Update - 5");
240 Report
.Failed
("Incorrect result from Procedure Update - 5");
242 ICS
.Free
(TC_chars_ptr
);
245 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
246 ICS
.Update
(Item
=> TC_chars_ptr
,
250 if ICS
.Value
(TC_chars_ptr
) = TC_Result_String_5
then
251 Report
.Comment
("Ada 95 result from Procedure Update - 6");
252 elsif ICS
.Value
(TC_chars_ptr
) = TC_Amd_Result_String_5
then
253 Report
.Comment
("Amendment 1 result from Procedure Update - 6");
255 Report
.Failed
("Incorrect result from Procedure Update - 6");
257 ICS
.Free
(TC_chars_ptr
);
260 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
261 ICS
.Update
(TC_chars_ptr
,
266 if ICS
.Value
(TC_chars_ptr
) = TC_Result_String_6
then
267 Report
.Comment
("Ada 95 result from Procedure Update - 7");
268 elsif ICS
.Value
(TC_chars_ptr
) = TC_Amd_Result_String_6
then
269 Report
.Comment
("Amendment 1 result from Procedure Update - 7");
271 Report
.Failed
("Incorrect result from Procedure Update - 7");
273 ICS
.Free
(TC_chars_ptr
);
276 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
277 ICS
.Update
(TC_chars_ptr
, 0, TC_String_9
, True);
279 if ICS
.Value
(TC_chars_ptr
) = TC_String_9
then
280 Report
.Comment
("Ada 95 result from Procedure Update - 8");
281 elsif ICS
.Value
(TC_chars_ptr
) = TC_Amd_Result_String_9
then
282 Report
.Comment
("Amendment 1 result from Procedure Update - 8");
284 Report
.Failed
("Incorrect result from Procedure Update - 8");
286 ICS
.Free
(TC_chars_ptr
);
288 -- Check what happens if the string and array are the same size (this
289 -- is the case that caused the change made by the Amendment).
291 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
292 ICS
.Update
(Item
=> TC_chars_ptr
,
296 if ICS
.Value
(TC_chars_ptr
) = TC_String_10
then
297 Report
.Comment
("Amendment 1 result from Procedure Update - 9");
299 Report
.Failed
("Incorrect result from Procedure Update - 9");
302 when ICS
.Update_Error
=>
303 Report
.Comment
("Ada 95 exception expected from Procedure Update - 9");
305 Report
.Failed
("Incorrect exception raised by Procedure Update " &
306 "with Str parameter - 9");
308 ICS
.Free
(TC_chars_ptr
);
311 -- Check that both of the above versions of Procedure Update will
312 -- propagate Update_Error if Check is True, and if the length of
313 -- the new chars in Chars, when overlaid starting from position
314 -- Offset, will overwrite the first nul in Item.
317 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
318 ICS
.Update
(Item
=> TC_chars_ptr
,
320 Chars
=> IC
.To_C
(TC_String_7
),
322 Report
.Failed
("Update_Error not raised by Procedure Update with " &
324 Report
.Comment
(ICS
.Value
(TC_chars_ptr
) & "used here to defeat " &
325 "optimization - should never be printed");
327 when ICS
.Update_Error
=> null; -- OK, expected exception.
329 Report
.Failed
("Incorrect exception raised by Procedure Update " &
330 "with Chars parameter");
333 ICS
.Free
(TC_chars_ptr
);
336 TC_chars_ptr
:= ICS
.New_Char_Array
(TC_char_array
);
337 ICS
.Update
(Item
=> TC_chars_ptr
,
338 Offset
=> ICS
.Strlen
(TC_chars_ptr
),
339 Str
=> TC_String_8
); -- Default Check parameter value.
340 Report
.Failed
("Update_Error not raised by Procedure Update with " &
342 Report
.Comment
(ICS
.Value
(TC_chars_ptr
) & "used here to defeat " &
343 "optimization - should never be printed");
345 when ICS
.Update_Error
=> null; -- OK, expected exception.
347 Report
.Failed
("Incorrect exception raised by Procedure Update " &
348 "with Str parameter");
351 ICS
.Free
(TC_chars_ptr
);
353 -- Check that both of the above versions of Procedure Update will
354 -- propagate Dereference_Error if Item is Null_Ptr.
355 -- Note: Free sets TC_chars_ptr to Null_Ptr.
358 ICS
.Update
(Item
=> TC_chars_ptr
,
360 Chars
=> IC
.To_C
(TC_String_7
),
362 Report
.Failed
("Dereference_Error not raised by Procedure Update with " &
365 when ICS
.Dereference_Error
=> null; -- OK, expected exception.
367 Report
.Failed
("Incorrect exception raised by Procedure Update " &
368 "with Chars parameter");
372 ICS
.Update
(Item
=> TC_chars_ptr
,
373 Offset
=> ICS
.Strlen
(TC_chars_ptr
),
374 Str
=> TC_String_8
); -- Default Check parameter value.
375 Report
.Failed
("Dereference_Error not raised by Procedure Update with " &
378 when ICS
.Dereference_Error
=> null; -- OK, expected exception.
380 Report
.Failed
("Incorrect exception raised by Procedure Update " &
381 "with Str parameter");
385 when The_Error
: others =>
386 Report
.Failed
("The following exception was raised in the " &
387 "Test_Block: " & Exception_Name
(The_Error
));