blob: 3771f6e6829e3765066264628bc4daa930762872 [file] [log] [blame]
-- 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;