1-- CXB3012.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 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. 31-- 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. 35-- 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. 40-- 41-- TEST DESCRIPTION: 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. 50-- 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. 53-- 54-- Finally, both versions of the procedure are evaluated to ensure that 55-- they propagate Update_Error and Dereference_Error under the proper 56-- conditions. 57-- 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 '.'. 61-- 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". 67-- 68-- 69-- CHANGE HISTORY: 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 76-- Corrigendum 1). 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.] 80 81--! 82 83with Report; 84with Ada.Exceptions; 85with Interfaces.C.Strings; -- N/A => ERROR 86 87procedure CXB3012 is 88begin 89 90 Report.Test ("CXB3012", "Check that both versions of Procedure Update " & 91 "produce correct results"); 92 93 Test_Block: 94 declare 95 96 package IC renames Interfaces.C; 97 package ICS renames Interfaces.C.Strings; 98 use Ada.Exceptions; 99 100 use type IC.char; 101 use type IC.char_array; 102 use type IC.size_t; 103 use type ICS.chars_ptr; 104 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"; 115 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---..."; 122 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"; 131 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; 136 137 begin 138 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. 146 147 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 148 149 ICS.Update(Item => TC_chars_ptr, 150 Offset => 0, 151 Chars => IC.To_C(TC_String_1, False), -- No nul char. 152 Check => True); 153 154 if ICS.Value(TC_chars_ptr) /= TC_Result_String_1 then 155 Report.Failed("Incorrect result from Procedure Update - 1"); 156 end if; 157 ICS.Free(TC_chars_ptr); 158 159 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. 164 Check => True); 165 166 if ICS.Value(TC_chars_ptr) /= TC_Result_String_2 then 167 Report.Failed("Incorrect result from Procedure Update - 2"); 168 end if; 169 ICS.Free(TC_chars_ptr); 170 171 172 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 173 ICS.Update(TC_chars_ptr, 174 3, 175 Chars => IC.To_C(TC_String_3), -- Nul appended, shortens 176 Check => False); -- array. 177 178 if ICS.Value(TC_chars_ptr) /= TC_Result_String_3 then 179 Report.Failed("Incorrect result from Procedure Update - 3"); 180 end if; 181 ICS.Free(TC_chars_ptr); 182 183 184 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 185 ICS.Update(TC_chars_ptr, 186 0, 187 IC.To_C(TC_String_10), -- Complete replacement of array. 188 Check => False); 189 190 if ICS.Value(TC_chars_ptr) /= TC_String_10 then 191 Report.Failed("Incorrect result from Procedure Update - 4"); 192 end if; 193 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). 198 begin 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))) 204 then 205 Report.Failed("Incorrect result from the character-by-" & 206 "character evaluation of the result of " & 207 "Procedure Update"); 208 end if; 209 end loop; 210 exception 211 when others => 212 Report.Failed("Exception raised during the character-by-" & 213 "character evaluation of the result of " & 214 "Procedure Update"); 215 end; 216 ICS.Free(TC_chars_ptr); 217 218 219 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 223 -- values in Item. 224 -- 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. 231 232 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 233 ICS.Update(TC_chars_ptr, 1, TC_String_4, False); 234 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"); 239 else 240 Report.Failed("Incorrect result from Procedure Update - 5"); 241 end if; 242 ICS.Free(TC_chars_ptr); 243 244 245 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 246 ICS.Update(Item => TC_chars_ptr, 247 Offset => 0, 248 Str => TC_String_5); 249 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"); 254 else 255 Report.Failed("Incorrect result from Procedure Update - 6"); 256 end if; 257 ICS.Free(TC_chars_ptr); 258 259 260 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 261 ICS.Update(TC_chars_ptr, 262 3, 263 Str => TC_String_6, 264 Check => True); 265 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"); 270 else 271 Report.Failed("Incorrect result from Procedure Update - 7"); 272 end if; 273 ICS.Free(TC_chars_ptr); 274 275 276 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 277 ICS.Update(TC_chars_ptr, 0, TC_String_9, True); 278 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"); 283 else 284 Report.Failed("Incorrect result from Procedure Update - 8"); 285 end if; 286 ICS.Free(TC_chars_ptr); 287 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). 290 begin 291 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 292 ICS.Update(Item => TC_chars_ptr, 293 Offset => 0, 294 Str => TC_String_10, 295 Check => True); 296 if ICS.Value(TC_chars_ptr) = TC_String_10 then 297 Report.Comment("Amendment 1 result from Procedure Update - 9"); 298 else 299 Report.Failed("Incorrect result from Procedure Update - 9"); 300 end if; 301 exception 302 when ICS.Update_Error => 303 Report.Comment("Ada 95 exception expected from Procedure Update - 9"); 304 when others => 305 Report.Failed("Incorrect exception raised by Procedure Update " & 306 "with Str parameter - 9"); 307 end; 308 ICS.Free(TC_chars_ptr); 309 310 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. 315 316 begin 317 TC_chars_ptr := ICS.New_Char_Array(TC_char_array); 318 ICS.Update(Item => TC_chars_ptr, 319 Offset => 5, 320 Chars => IC.To_C(TC_String_7), 321 Check => True); 322 Report.Failed("Update_Error not raised by Procedure Update with " & 323 "Chars parameter"); 324 Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " & 325 "optimization - should never be printed"); 326 exception 327 when ICS.Update_Error => null; -- OK, expected exception. 328 when others => 329 Report.Failed("Incorrect exception raised by Procedure Update " & 330 "with Chars parameter"); 331 end; 332 333 ICS.Free(TC_chars_ptr); 334 335 begin 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 " & 341 "Str parameter"); 342 Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " & 343 "optimization - should never be printed"); 344 exception 345 when ICS.Update_Error => null; -- OK, expected exception. 346 when others => 347 Report.Failed("Incorrect exception raised by Procedure Update " & 348 "with Str parameter"); 349 end; 350 351 ICS.Free(TC_chars_ptr); 352 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. 356 357 begin 358 ICS.Update(Item => TC_chars_ptr, 359 Offset => 5, 360 Chars => IC.To_C(TC_String_7), 361 Check => True); 362 Report.Failed("Dereference_Error not raised by Procedure Update with " & 363 "Chars parameter"); 364 exception 365 when ICS.Dereference_Error => null; -- OK, expected exception. 366 when others => 367 Report.Failed("Incorrect exception raised by Procedure Update " & 368 "with Chars parameter"); 369 end; 370 371 begin 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 " & 376 "Str parameter"); 377 exception 378 when ICS.Dereference_Error => null; -- OK, expected exception. 379 when others => 380 Report.Failed("Incorrect exception raised by Procedure Update " & 381 "with Str parameter"); 382 end; 383 384 exception 385 when The_Error : others => 386 Report.Failed ("The following exception was raised in the " & 387 "Test_Block: " & Exception_Name(The_Error)); 388 end Test_Block; 389 390 Report.Result; 391 392end CXB3012; 393