| -- 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). |
| -- 07 Jan 05 RLB Modified to reflect change to Update by AI-242 |
| -- (which is expected to be part of Amendment 1). |
| -- [This version allows either semantics.] |
| |
| --! |
| |
| 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_Amd_Result_String_4 : |
| constant String := "XACVCXXXXX"; |
| TC_Amd_Result_String_5 : |
| constant String := "1a2b3XXXXX"; |
| TC_Amd_Result_String_6 : |
| constant String := "XXX---...X"; |
| TC_Amd_Result_String_9 : |
| constant String := "JustATestX"; |
| |
| 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 Ada 95, 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. For Ada 2005, this rule is dropped, so the |
| -- number of characters remains the same. |
| |
| 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.Comment("Ada 95 result from Procedure Update - 5"); |
| elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_4 then |
| Report.Comment("Amendment 1 result from Procedure Update - 5"); |
| else |
| 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.Comment("Ada 95 result from Procedure Update - 6"); |
| elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_5 then |
| Report.Comment("Amendment 1 result from Procedure Update - 6"); |
| else |
| 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.Comment("Ada 95 result from Procedure Update - 7"); |
| elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_6 then |
| Report.Comment("Amendment 1 result from Procedure Update - 7"); |
| else |
| 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.Comment("Ada 95 result from Procedure Update - 8"); |
| elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_9 then |
| Report.Comment("Amendment 1 result from Procedure Update - 8"); |
| else |
| Report.Failed("Incorrect result from Procedure Update - 8"); |
| end if; |
| ICS.Free(TC_chars_ptr); |
| |
| -- Check what happens if the string and array are the same size (this |
| -- is the case that caused the change made by the Amendment). |
| begin |
| TC_chars_ptr := ICS.New_Char_Array(TC_char_array); |
| ICS.Update(Item => TC_chars_ptr, |
| Offset => 0, |
| Str => TC_String_10, |
| Check => True); |
| if ICS.Value(TC_chars_ptr) = TC_String_10 then |
| Report.Comment("Amendment 1 result from Procedure Update - 9"); |
| else |
| Report.Failed("Incorrect result from Procedure Update - 9"); |
| end if; |
| exception |
| when ICS.Update_Error => |
| Report.Comment("Ada 95 exception expected from Procedure Update - 9"); |
| when others => |
| Report.Failed("Incorrect exception raised by Procedure Update " & |
| "with Str parameter - 9"); |
| end; |
| 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; |
