-- CXB3012.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- OBJECTIVE: -- Check that Procedure Update modifies the value pointed to by -- the chars_ptr parameter Item, starting at the position -- corresponding to parameter Offset, using the chars in -- char_array parameter Chars. -- -- Check that the version of Procedure Update with a String parameter -- behaves in the manner described above, but with the character -- values in the String overwriting the char values in Item. -- -- Check that both of the above versions of Procedure Update will -- propagate Update_Error if Check is True, and if the length of -- the new chars in Chars, when overlaid starting from position -- Offset, will overwrite the first nul in Item. -- -- TEST DESCRIPTION: -- This test checks two versions of Procedure Update. In the first -- version of the procedure, the parameter Chars indicates a char_array -- argument. These char_array parameters are provided through the use -- of the To_C function (with String IN parameter), both with and -- without a terminating nul. In the case below where a terminating nul -- char is appended, the effect of "updating" the value pointed to by the -- Item parameter will include its shortening, due to the insertion of -- this additional nul in the middle of the char_array. -- -- In the second version of Procedure Update evaluated here, the string -- parameter Str is used to modify the char_array pointed to by Item. -- -- Finally, both versions of the procedure are evaluated to ensure that -- they propagate Update_Error and Dereference_Error under the proper -- conditions. -- -- This test assumes that the following characters are all included -- in the implementation defined type Interfaces.C.char: -- ' ', 'a'..'z', 'A'..'Z', '0'..'9', '-' and '.'. -- -- APPLICABILITY CRITERIA: -- This test is applicable to all implementations that provide -- package Interfaces.C.Strings. If an implementation provides -- package Interfaces.C.Strings, this test must compile, execute, -- and report "PASSED". -- -- -- CHANGE HISTORY: -- 05 Oct 95 SAIC Initial prerelease version. -- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. -- 26 Oct 96 SAIC Incorporated reviewer comments. -- 14 Sep 99 RLB Removed incorrect and unnecessary -- Unchecked_Conversion. Added check for raising -- of Dereference_Error for Update (From Technical -- Corrigendum 1). -- --! with Report; with Ada.Exceptions; with Interfaces.C.Strings; -- N/A => ERROR procedure CXB3012 is begin Report.Test ("CXB3012", "Check that both versions of Procedure Update " & "produce correct results"); Test_Block: declare package IC renames Interfaces.C; package ICS renames Interfaces.C.Strings; use Ada.Exceptions; use type IC.char; use type IC.char_array; use type IC.size_t; use type ICS.chars_ptr; TC_String_1 : String(1..1) := "J"; TC_String_2 : String(1..2) := "Ab"; TC_String_3 : String(1..3) := "xyz"; TC_String_4 : String(1..4) := "ACVC"; TC_String_5 : String(1..5) := "1a2b3"; TC_String_6 : String(1..6) := "---..."; TC_String_7 : String(1..7) := "AABBBAA"; TC_String_8 : String(1..8) := "aBcDeFgH"; TC_String_9 : String(1..9) := "JustATest"; TC_String_10 : String(1..10) := "0123456789"; TC_Result_String_1 : constant String := "JXXXXXXXXX"; TC_Result_String_2 : constant String := "XXXXXXXXAb"; TC_Result_String_3 : constant String := "XXXxyz"; TC_Result_String_4 : constant String := "XACVC"; TC_Result_String_5 : constant String := "1a2b3"; TC_Result_String_6 : constant String := "XXX---..."; TC_char_array : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX"); TC_Result_char_array : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX"); TC_chars_ptr : ICS.chars_ptr; TC_Length : IC.size_t; begin -- Check that Procedure Update modifies the value pointed to by -- the chars_ptr parameter Item, starting at the position -- corresponding to parameter Offset, using the chars in -- char_array parameter Chars. -- Note: If parameter Chars contains a nul char (such as a -- terminating nul), the result may be the overall shortening -- of parameter Item. TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(Item => TC_chars_ptr, Offset => 0, Chars => IC.To_C(TC_String_1, False), -- No nul char. Check => True); if ICS.Value(TC_chars_ptr) /= TC_Result_String_1 then Report.Failed("Incorrect result from Procedure Update - 1"); end if; ICS.Free(TC_chars_ptr); TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(TC_chars_ptr, Offset => ICS.Strlen(TC_chars_ptr) - 2, Chars => IC.To_C(TC_String_2, False), -- No nul char. Check => True); if ICS.Value(TC_chars_ptr) /= TC_Result_String_2 then Report.Failed("Incorrect result from Procedure Update - 2"); end if; ICS.Free(TC_chars_ptr); TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(TC_chars_ptr, 3, Chars => IC.To_C(TC_String_3), -- Nul appended, shortens Check => False); -- array. if ICS.Value(TC_chars_ptr) /= TC_Result_String_3 then Report.Failed("Incorrect result from Procedure Update - 3"); end if; ICS.Free(TC_chars_ptr); TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(TC_chars_ptr, 0, IC.To_C(TC_String_10), -- Complete replacement of array. Check => False); if ICS.Value(TC_chars_ptr) /= TC_String_10 then Report.Failed("Incorrect result from Procedure Update - 4"); end if; -- Perform a character-by-character comparison of the result of -- Procedure Update. Note that char_array lower bound is 0, and -- that the nul char is not compared with any character in the -- string (since the string is not nul terminated). begin TC_Length := ICS.Strlen(TC_chars_ptr); TC_Result_char_array(0..10) := ICS.Value(TC_chars_ptr); for i in 0..TC_Length-1 loop if TC_Result_char_array(i) /= IC.To_C(TC_String_10(Integer(i+1))) then Report.Failed("Incorrect result from the character-by-" & "character evaluation of the result of " & "Procedure Update"); end if; end loop; exception when others => Report.Failed("Exception raised during the character-by-" & "character evaluation of the result of " & "Procedure Update"); end; ICS.Free(TC_chars_ptr); -- Check that the version of Procedure Update with a String rather -- than a char_array parameter behaves in the manner described above, -- but with the character values in the String overwriting the char -- values in Item. -- -- Note: In each of the cases below, the String parameter Str is -- treated as if it were nul terminated, which means that the -- char_array pointed to by TC_chars_ptr will be "shortened" -- so that it ends after the last character of the Str -- parameter. TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(TC_chars_ptr, 1, TC_String_4, False); if ICS.Value(TC_chars_ptr) /= TC_Result_String_4 then Report.Failed("Incorrect result from Procedure Update - 5"); end if; ICS.Free(TC_chars_ptr); TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(Item => TC_chars_ptr, Offset => 0, Str => TC_String_5); if ICS.Value(TC_chars_ptr) /= TC_Result_String_5 then Report.Failed("Incorrect result from Procedure Update - 6"); end if; ICS.Free(TC_chars_ptr); TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(TC_chars_ptr, 3, Str => TC_String_6, Check => True); if ICS.Value(TC_chars_ptr) /= TC_Result_String_6 then Report.Failed("Incorrect result from Procedure Update - 7"); end if; ICS.Free(TC_chars_ptr); TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(TC_chars_ptr, 0, TC_String_9, True); if ICS.Value(TC_chars_ptr) /= TC_String_9 then Report.Failed("Incorrect result from Procedure Update - 8"); end if; ICS.Free(TC_chars_ptr); -- Check that both of the above versions of Procedure Update will -- propagate Update_Error if Check is True, and if the length of -- the new chars in Chars, when overlaid starting from position -- Offset, will overwrite the first nul in Item. begin TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(Item => TC_chars_ptr, Offset => 5, Chars => IC.To_C(TC_String_7), Check => True); Report.Failed("Update_Error not raised by Procedure Update with " & "Chars parameter"); Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " & "optimization - should never be printed"); exception when ICS.Update_Error => null; -- OK, expected exception. when others => Report.Failed("Incorrect exception raised by Procedure Update " & "with Chars parameter"); end; ICS.Free(TC_chars_ptr); begin TC_chars_ptr := ICS.New_Char_Array(TC_char_array); ICS.Update(Item => TC_chars_ptr, Offset => ICS.Strlen(TC_chars_ptr), Str => TC_String_8); -- Default Check parameter value. Report.Failed("Update_Error not raised by Procedure Update with " & "Str parameter"); Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " & "optimization - should never be printed"); exception when ICS.Update_Error => null; -- OK, expected exception. when others => Report.Failed("Incorrect exception raised by Procedure Update " & "with Str parameter"); end; ICS.Free(TC_chars_ptr); -- Check that both of the above versions of Procedure Update will -- propagate Dereference_Error if Item is Null_Ptr. -- Note: Free sets TC_chars_ptr to Null_Ptr. begin ICS.Update(Item => TC_chars_ptr, Offset => 5, Chars => IC.To_C(TC_String_7), Check => True); Report.Failed("Dereference_Error not raised by Procedure Update with " & "Chars parameter"); exception when ICS.Dereference_Error => null; -- OK, expected exception. when others => Report.Failed("Incorrect exception raised by Procedure Update " & "with Chars parameter"); end; begin ICS.Update(Item => TC_chars_ptr, Offset => ICS.Strlen(TC_chars_ptr), Str => TC_String_8); -- Default Check parameter value. Report.Failed("Dereference_Error not raised by Procedure Update with " & "Str parameter"); exception when ICS.Dereference_Error => null; -- OK, expected exception. when others => Report.Failed("Incorrect exception raised by Procedure Update " & "with Str parameter"); end; exception when The_Error : others => Report.Failed ("The following exception was raised in the " & "Test_Block: " & Exception_Name(The_Error)); end Test_Block; Report.Result; end CXB3012;