-- CXA4005.A
|
-- CXA4005.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that the subprograms defined in package Ada.Strings.Fixed are
|
-- Check that the subprograms defined in package Ada.Strings.Fixed are
|
-- available, and that they produce correct results. Specifically,
|
-- available, and that they produce correct results. Specifically,
|
-- check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice,
|
-- check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice,
|
-- Tail, Trim, and "*".
|
-- Tail, Trim, and "*".
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test, when combined with tests CXA4002-4 will provide coverage
|
-- This test, when combined with tests CXA4002-4 will provide coverage
|
-- of the functionality found in Ada.Strings.Fixed.
|
-- of the functionality found in Ada.Strings.Fixed.
|
-- This test contains many small, specific test cases, situations that
|
-- This test contains many small, specific test cases, situations that
|
-- although common in user environments, are often difficult to generate
|
-- although common in user environments, are often difficult to generate
|
-- in large numbers in a application-based test. They represent
|
-- in large numbers in a application-based test. They represent
|
-- individual usage paradigms in-the-small.
|
-- individual usage paradigms in-the-small.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 11 Apr 95 SAIC Corrected acceptance conditions of certain
|
-- 11 Apr 95 SAIC Corrected acceptance conditions of certain
|
-- subtests.
|
-- subtests.
|
-- 06 Nov 95 SAIC Fixed bugs for ACVC 2.0.1.
|
-- 06 Nov 95 SAIC Fixed bugs for ACVC 2.0.1.
|
-- 22 Feb 01 PHL Check that the lower bound of the result is 1.
|
-- 22 Feb 01 PHL Check that the lower bound of the result is 1.
|
-- 13 Mar 01 RLB Fixed a couple of ACATS style violations;
|
-- 13 Mar 01 RLB Fixed a couple of ACATS style violations;
|
-- removed pointless checks of procedures.
|
-- removed pointless checks of procedures.
|
-- Added checks of other functions. These changes
|
-- Added checks of other functions. These changes
|
-- were made to test Defect Report 8652/0049, as
|
-- were made to test Defect Report 8652/0049, as
|
-- reflected in Technical Corrigendum 1.
|
-- reflected in Technical Corrigendum 1.
|
--
|
--
|
--!
|
--!
|
|
|
with Report;
|
with Report;
|
with Ada.Strings;
|
with Ada.Strings;
|
with Ada.Strings.Fixed;
|
with Ada.Strings.Fixed;
|
with Ada.Strings.Maps;
|
with Ada.Strings.Maps;
|
|
|
procedure CXA4005 is
|
procedure CXA4005 is
|
|
|
type TC_Name_Holder is access String;
|
type TC_Name_Holder is access String;
|
Name : TC_Name_Holder;
|
Name : TC_Name_Holder;
|
|
|
function TC_Check (S : String) return String is
|
function TC_Check (S : String) return String is
|
begin
|
begin
|
if S'First /= 1 then
|
if S'First /= 1 then
|
Report.Failed ("Lower bound of result of function " & Name.all &
|
Report.Failed ("Lower bound of result of function " & Name.all &
|
" is" & Integer'Image (S'First));
|
" is" & Integer'Image (S'First));
|
end if;
|
end if;
|
return S;
|
return S;
|
end TC_Check;
|
end TC_Check;
|
|
|
procedure TC_Set_Name (N : String) is
|
procedure TC_Set_Name (N : String) is
|
begin
|
begin
|
Name := new String'(N);
|
Name := new String'(N);
|
end TC_Set_Name;
|
end TC_Set_Name;
|
|
|
begin
|
begin
|
|
|
Report.Test("CXA4005", "Check that the subprograms defined in " &
|
Report.Test("CXA4005", "Check that the subprograms defined in " &
|
"package Ada.Strings.Fixed are available, " &
|
"package Ada.Strings.Fixed are available, " &
|
"and that they produce correct results");
|
"and that they produce correct results");
|
|
|
Test_Block:
|
Test_Block:
|
declare
|
declare
|
|
|
package ASF renames Ada.Strings.Fixed;
|
package ASF renames Ada.Strings.Fixed;
|
package Maps renames Ada.Strings.Maps;
|
package Maps renames Ada.Strings.Maps;
|
|
|
Result_String,
|
Result_String,
|
Delete_String,
|
Delete_String,
|
Insert_String,
|
Insert_String,
|
Trim_String,
|
Trim_String,
|
Overwrite_String : String(1..10) := (others => Ada.Strings.Space);
|
Overwrite_String : String(1..10) := (others => Ada.Strings.Space);
|
|
|
Source_String1 : String(1..5) := "abcde"; -- odd length string
|
Source_String1 : String(1..5) := "abcde"; -- odd length string
|
Source_String2 : String(1..6) := "abcdef"; -- even length string
|
Source_String2 : String(1..6) := "abcdef"; -- even length string
|
Source_String3 : String(1..12) := "abcdefghijkl";
|
Source_String3 : String(1..12) := "abcdefghijkl";
|
Source_String4 : String(1..12) := "abcdefghij "; -- last two ch pad
|
Source_String4 : String(1..12) := "abcdefghij "; -- last two ch pad
|
Source_String5 : String(1..12) := " cdefghijkl"; -- first two ch pad
|
Source_String5 : String(1..12) := " cdefghijkl"; -- first two ch pad
|
Source_String6 : String(1..12) := "abcdefabcdef";
|
Source_String6 : String(1..12) := "abcdefabcdef";
|
|
|
Location : Natural := 0;
|
Location : Natural := 0;
|
Slice_Start : Positive;
|
Slice_Start : Positive;
|
Slice_End,
|
Slice_End,
|
Slice_Count : Natural := 0;
|
Slice_Count : Natural := 0;
|
|
|
CD_Set : Maps.Character_Set := Maps.To_Set("cd");
|
CD_Set : Maps.Character_Set := Maps.To_Set("cd");
|
X_Set : Maps.Character_Set := Maps.To_Set('x');
|
X_Set : Maps.Character_Set := Maps.To_Set('x');
|
ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd");
|
ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd");
|
A_to_F_Set : Maps.Character_Set := Maps.To_Set("abcdef");
|
A_to_F_Set : Maps.Character_Set := Maps.To_Set("abcdef");
|
|
|
CD_to_XY_Map : Maps.Character_Mapping :=
|
CD_to_XY_Map : Maps.Character_Mapping :=
|
Maps.To_Mapping(From => "cd", To => "xy");
|
Maps.To_Mapping(From => "cd", To => "xy");
|
|
|
begin
|
begin
|
|
|
-- Procedure Replace_Slice
|
-- Procedure Replace_Slice
|
-- The functionality of this procedure
|
-- The functionality of this procedure
|
-- is similar to procedure Move, and
|
-- is similar to procedure Move, and
|
-- is tested here in the same manner, evaluated
|
-- is tested here in the same manner, evaluated
|
-- with various combinations of parameters.
|
-- with various combinations of parameters.
|
|
|
-- Index_Error propagation when Low > Source'Last + 1
|
-- Index_Error propagation when Low > Source'Last + 1
|
|
|
begin
|
begin
|
ASF.Replace_Slice(Result_String,
|
ASF.Replace_Slice(Result_String,
|
Result_String'Last + 2, -- should raise exception
|
Result_String'Last + 2, -- should raise exception
|
Result_String'Last,
|
Result_String'Last,
|
"xxxxxxx");
|
"xxxxxxx");
|
Report.Failed("Index_Error not raised by Replace_Slice - 1");
|
Report.Failed("Index_Error not raised by Replace_Slice - 1");
|
exception
|
exception
|
when Ada.Strings.Index_Error => null; -- OK, expected exception.
|
when Ada.Strings.Index_Error => null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception from Replace_Slice - 1");
|
Report.Failed("Incorrect exception from Replace_Slice - 1");
|
end;
|
end;
|
|
|
-- Index_Error propagation when High < Source'First - 1
|
-- Index_Error propagation when High < Source'First - 1
|
|
|
begin
|
begin
|
ASF.Replace_Slice(Result_String(5..10),
|
ASF.Replace_Slice(Result_String(5..10),
|
5,
|
5,
|
3, -- should raise exception since < 'First - 1.
|
3, -- should raise exception since < 'First - 1.
|
"xxxxxxx");
|
"xxxxxxx");
|
Report.Failed("Index_Error not raised by Replace_Slice - 2");
|
Report.Failed("Index_Error not raised by Replace_Slice - 2");
|
exception
|
exception
|
when Ada.Strings.Index_Error => null; -- OK, expected exception.
|
when Ada.Strings.Index_Error => null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception from Replace_Slice - 2");
|
Report.Failed("Incorrect exception from Replace_Slice - 2");
|
end;
|
end;
|
|
|
-- Justify = Left (default case)
|
-- Justify = Left (default case)
|
|
|
Result_String := "XXXXXXXXXX";
|
Result_String := "XXXXXXXXXX";
|
|
|
ASF.Replace_Slice(Source => Result_String,
|
ASF.Replace_Slice(Source => Result_String,
|
Low => 1,
|
Low => 1,
|
High => 10,
|
High => 10,
|
By => Source_String1); -- "abcde"
|
By => Source_String1); -- "abcde"
|
|
|
if Result_String /= "abcde " then
|
if Result_String /= "abcde " then
|
Report.Failed("Incorrect result from Replace_Slice - Justify = Left");
|
Report.Failed("Incorrect result from Replace_Slice - Justify = Left");
|
end if;
|
end if;
|
|
|
-- Justify = Right
|
-- Justify = Right
|
|
|
ASF.Replace_Slice(Source => Result_String,
|
ASF.Replace_Slice(Source => Result_String,
|
Low => 1,
|
Low => 1,
|
High => Result_String'Last,
|
High => Result_String'Last,
|
By => Source_String2, -- "abcdef"
|
By => Source_String2, -- "abcdef"
|
Drop => Ada.Strings.Error,
|
Drop => Ada.Strings.Error,
|
Justify => Ada.Strings.Right);
|
Justify => Ada.Strings.Right);
|
|
|
if Result_String /= " abcdef" then
|
if Result_String /= " abcdef" then
|
Report.Failed("Incorrect result from Replace_Slice - Justify=Right");
|
Report.Failed("Incorrect result from Replace_Slice - Justify=Right");
|
end if;
|
end if;
|
|
|
-- Justify = Center (two cases, odd and even pad lengths)
|
-- Justify = Center (two cases, odd and even pad lengths)
|
|
|
ASF.Replace_Slice(Result_String,
|
ASF.Replace_Slice(Result_String,
|
1,
|
1,
|
Result_String'Last,
|
Result_String'Last,
|
Source_String1, -- "abcde"
|
Source_String1, -- "abcde"
|
Ada.Strings.Error,
|
Ada.Strings.Error,
|
Ada.Strings.Center,
|
Ada.Strings.Center,
|
'x'); -- non-default padding.
|
'x'); -- non-default padding.
|
|
|
if Result_String /= "xxabcdexxx" then -- Unequal padding added right
|
if Result_String /= "xxabcdexxx" then -- Unequal padding added right
|
Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1");
|
Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1");
|
end if;
|
end if;
|
|
|
ASF.Replace_Slice(Result_String,
|
ASF.Replace_Slice(Result_String,
|
1,
|
1,
|
Result_String'Last,
|
Result_String'Last,
|
Source_String2, -- "abcdef"
|
Source_String2, -- "abcdef"
|
Ada.Strings.Error,
|
Ada.Strings.Error,
|
Ada.Strings.Center);
|
Ada.Strings.Center);
|
|
|
if Result_String /= " abcdef " then -- Equal padding added on L/R.
|
if Result_String /= " abcdef " then -- Equal padding added on L/R.
|
Report.Failed("Incorrect result from Replace_Slice with " &
|
Report.Failed("Incorrect result from Replace_Slice with " &
|
"Justify = Center - 2");
|
"Justify = Center - 2");
|
end if;
|
end if;
|
|
|
-- When the source string is longer than the target string, several
|
-- When the source string is longer than the target string, several
|
-- cases can be examined, with the results depending on the value of
|
-- cases can be examined, with the results depending on the value of
|
-- the Drop parameter.
|
-- the Drop parameter.
|
|
|
-- Drop = Left
|
-- Drop = Left
|
|
|
ASF.Replace_Slice(Result_String,
|
ASF.Replace_Slice(Result_String,
|
1,
|
1,
|
Result_String'Last,
|
Result_String'Last,
|
Source_String3, -- "abcdefghijkl"
|
Source_String3, -- "abcdefghijkl"
|
Drop => Ada.Strings.Left);
|
Drop => Ada.Strings.Left);
|
|
|
if Result_String /= "cdefghijkl" then
|
if Result_String /= "cdefghijkl" then
|
Report.Failed("Incorrect result from Replace_Slice - Drop=Left");
|
Report.Failed("Incorrect result from Replace_Slice - Drop=Left");
|
end if;
|
end if;
|
|
|
-- Drop = Right
|
-- Drop = Right
|
|
|
ASF.Replace_Slice(Result_String,
|
ASF.Replace_Slice(Result_String,
|
1,
|
1,
|
Result_String'Last,
|
Result_String'Last,
|
Source_String3, -- "abcdefghijkl"
|
Source_String3, -- "abcdefghijkl"
|
Ada.Strings.Right);
|
Ada.Strings.Right);
|
|
|
if Result_String /= "abcdefghij" then
|
if Result_String /= "abcdefghij" then
|
Report.Failed("Incorrect result, Replace_Slice with Drop=Right");
|
Report.Failed("Incorrect result, Replace_Slice with Drop=Right");
|
end if;
|
end if;
|
|
|
-- Drop = Error
|
-- Drop = Error
|
|
|
-- The effect in this case depends on the value of the justify
|
-- The effect in this case depends on the value of the justify
|
-- parameter, and on whether any characters in Source other than
|
-- parameter, and on whether any characters in Source other than
|
-- Pad would fail to be copied.
|
-- Pad would fail to be copied.
|
|
|
-- Drop = Error, Justify = Left, right overflow characters are pad.
|
-- Drop = Error, Justify = Left, right overflow characters are pad.
|
|
|
ASF.Replace_Slice(Result_String,
|
ASF.Replace_Slice(Result_String,
|
1,
|
1,
|
Result_String'Last,
|
Result_String'Last,
|
Source_String4, -- "abcdefghij "
|
Source_String4, -- "abcdefghij "
|
Drop => Ada.Strings.Error,
|
Drop => Ada.Strings.Error,
|
Justify => Ada.Strings.Left);
|
Justify => Ada.Strings.Left);
|
|
|
if not(Result_String = "abcdefghij") then -- leftmost 10 characters
|
if not(Result_String = "abcdefghij") then -- leftmost 10 characters
|
Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1");
|
Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1");
|
end if;
|
end if;
|
|
|
-- Drop = Error, Justify = Right, left overflow characters are pad.
|
-- Drop = Error, Justify = Right, left overflow characters are pad.
|
|
|
ASF.Replace_Slice(Source => Result_String,
|
ASF.Replace_Slice(Source => Result_String,
|
Low => 1,
|
Low => 1,
|
High => Result_String'Last,
|
High => Result_String'Last,
|
By => Source_String5, -- " cdefghijkl"
|
By => Source_String5, -- " cdefghijkl"
|
Drop => Ada.Strings.Error,
|
Drop => Ada.Strings.Error,
|
Justify => Ada.Strings.Right);
|
Justify => Ada.Strings.Right);
|
|
|
if Result_String /= "cdefghijkl" then -- rightmost 10 characters
|
if Result_String /= "cdefghijkl" then -- rightmost 10 characters
|
Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2");
|
Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2");
|
end if;
|
end if;
|
|
|
-- In other cases of Drop=Error, Length_Error is propagated, such as:
|
-- In other cases of Drop=Error, Length_Error is propagated, such as:
|
|
|
begin
|
begin
|
|
|
ASF.Replace_Slice(Source => Result_String,
|
ASF.Replace_Slice(Source => Result_String,
|
Low => 1,
|
Low => 1,
|
High => Result_String'Last,
|
High => Result_String'Last,
|
By => Source_String3, -- "abcdefghijkl"
|
By => Source_String3, -- "abcdefghijkl"
|
Drop => Ada.Strings.Error);
|
Drop => Ada.Strings.Error);
|
|
|
Report.Failed("Length_Error not raised by Replace_Slice - 1");
|
Report.Failed("Length_Error not raised by Replace_Slice - 1");
|
|
|
exception
|
exception
|
when Ada.Strings.Length_Error => null; -- OK
|
when Ada.Strings.Length_Error => null; -- OK
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception from Replace_Slice - 3");
|
Report.Failed("Incorrect exception from Replace_Slice - 3");
|
end;
|
end;
|
|
|
|
|
-- Function Replace_Slice
|
-- Function Replace_Slice
|
|
|
TC_Set_Name ("Replace_Slice");
|
TC_Set_Name ("Replace_Slice");
|
|
|
if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x"))
|
if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x"))
|
/= "abxde" or -- High = Low
|
/= "abxde" or -- High = Low
|
TC_Check (ASF.Replace_Slice("abc", 2, 3, "xyz")) /= "axyz" or
|
TC_Check (ASF.Replace_Slice("abc", 2, 3, "xyz")) /= "axyz" or
|
TC_Check (ASF.Replace_Slice("abcd", 4, 1, "xy"))
|
TC_Check (ASF.Replace_Slice("abcd", 4, 1, "xy"))
|
/= "abcxyd" or -- High < Low
|
/= "abcxyd" or -- High < Low
|
TC_Check (ASF.Replace_Slice("abc", 2, 3, "x")) /= "ax" or
|
TC_Check (ASF.Replace_Slice("abc", 2, 3, "x")) /= "ax" or
|
TC_Check (ASF.Replace_Slice("a", 1, 1, "z")) /= "z"
|
TC_Check (ASF.Replace_Slice("a", 1, 1, "z")) /= "z"
|
then
|
then
|
Report.Failed("Incorrect result from Function Replace_Slice - 1");
|
Report.Failed("Incorrect result from Function Replace_Slice - 1");
|
end if;
|
end if;
|
|
|
if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z"))
|
if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z"))
|
/= "abcdz" or -- By length 1
|
/= "abcdz" or -- By length 1
|
TC_Check (ASF.Replace_Slice("abc", 1, 3, "xyz"))
|
TC_Check (ASF.Replace_Slice("abc", 1, 3, "xyz"))
|
/= "xyz" or -- High > Low
|
/= "xyz" or -- High > Low
|
TC_Check (ASF.Replace_Slice("abc", 3, 2, "xy"))
|
TC_Check (ASF.Replace_Slice("abc", 3, 2, "xy"))
|
/= "abxyc" or -- insert
|
/= "abxyc" or -- insert
|
TC_Check (ASF.Replace_Slice("a", 1, 1, "xyz")) /= "xyz"
|
TC_Check (ASF.Replace_Slice("a", 1, 1, "xyz")) /= "xyz"
|
then
|
then
|
Report.Failed("Incorrect result from Function Replace_Slice - 2");
|
Report.Failed("Incorrect result from Function Replace_Slice - 2");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Function Insert.
|
-- Function Insert.
|
|
|
TC_Set_Name ("Insert");
|
TC_Set_Name ("Insert");
|
|
|
declare
|
declare
|
New_String : constant String :=
|
New_String : constant String :=
|
TC_Check (
|
TC_Check (
|
ASF.Insert(Source => Source_String1(2..5), -- "bcde"
|
ASF.Insert(Source => Source_String1(2..5), -- "bcde"
|
Before => 3,
|
Before => 3,
|
New_Item => Source_String2)); -- "abcdef"
|
New_Item => Source_String2)); -- "abcdef"
|
begin
|
begin
|
if New_String /= "babcdefcde" then
|
if New_String /= "babcdefcde" then
|
Report.Failed("Incorrect result from Function Insert - 1");
|
Report.Failed("Incorrect result from Function Insert - 1");
|
end if;
|
end if;
|
end;
|
end;
|
|
|
if TC_Check (ASF.Insert("a", 1, "z")) /= "za" or
|
if TC_Check (ASF.Insert("a", 1, "z")) /= "za" or
|
TC_Check (ASF.Insert("abc", 3, "")) /= "abc" or
|
TC_Check (ASF.Insert("abc", 3, "")) /= "abc" or
|
TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc"
|
TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc"
|
then
|
then
|
Report.Failed("Incorrect result from Function Insert - 2");
|
Report.Failed("Incorrect result from Function Insert - 2");
|
end if;
|
end if;
|
|
|
begin
|
begin
|
if TC_Check (ASF.Insert(Source => Source_String1(2..5), -- "bcde"
|
if TC_Check (ASF.Insert(Source => Source_String1(2..5), -- "bcde"
|
Before => Report.Ident_Int(7),
|
Before => Report.Ident_Int(7),
|
New_Item => Source_String2)) -- "abcdef"
|
New_Item => Source_String2)) -- "abcdef"
|
/= "babcdefcde" then
|
/= "babcdefcde" then
|
Report.Failed("Index_Error not raised by Insert - 3A");
|
Report.Failed("Index_Error not raised by Insert - 3A");
|
else
|
else
|
Report.Failed("Index_Error not raised by Insert - 3B");
|
Report.Failed("Index_Error not raised by Insert - 3B");
|
end if;
|
end if;
|
exception
|
exception
|
when Ada.Strings.Index_Error => null; -- OK, expected exception.
|
when Ada.Strings.Index_Error => null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception from Insert - 3");
|
Report.Failed("Incorrect exception from Insert - 3");
|
end;
|
end;
|
|
|
|
|
-- Procedure Insert
|
-- Procedure Insert
|
|
|
-- Drop = Right
|
-- Drop = Right
|
|
|
ASF.Insert(Source => Insert_String,
|
ASF.Insert(Source => Insert_String,
|
Before => 6,
|
Before => 6,
|
New_Item => Source_String2, -- "abcdef"
|
New_Item => Source_String2, -- "abcdef"
|
Drop => Ada.Strings.Right);
|
Drop => Ada.Strings.Right);
|
|
|
if Insert_String /= " abcde" then -- last char of New_Item dropped.
|
if Insert_String /= " abcde" then -- last char of New_Item dropped.
|
Report.Failed("Incorrect result from Insert with Drop = Right");
|
Report.Failed("Incorrect result from Insert with Drop = Right");
|
end if;
|
end if;
|
|
|
-- Drop = Left
|
-- Drop = Left
|
|
|
ASF.Insert(Source => Insert_String, -- 10 char string
|
ASF.Insert(Source => Insert_String, -- 10 char string
|
Before => 2, -- 9 chars, 2..10 available
|
Before => 2, -- 9 chars, 2..10 available
|
New_Item => Source_String3, -- 12 characters long.
|
New_Item => Source_String3, -- 12 characters long.
|
Drop => Ada.Strings.Left); -- truncate from Left.
|
Drop => Ada.Strings.Left); -- truncate from Left.
|
|
|
if Insert_String /= "l abcde" then -- 10 chars, leading blank.
|
if Insert_String /= "l abcde" then -- 10 chars, leading blank.
|
Report.Failed("Incorrect result from Insert with Drop=Left");
|
Report.Failed("Incorrect result from Insert with Drop=Left");
|
end if;
|
end if;
|
|
|
-- Drop = Error
|
-- Drop = Error
|
|
|
begin
|
begin
|
ASF.Insert(Source => Result_String, -- 10 chars
|
ASF.Insert(Source => Result_String, -- 10 chars
|
Before => Result_String'Last,
|
Before => Result_String'Last,
|
New_Item => "abcdefghijk",
|
New_Item => "abcdefghijk",
|
Drop => Ada.Strings.Error);
|
Drop => Ada.Strings.Error);
|
Report.Failed("Exception not raised by Procedure Insert");
|
Report.Failed("Exception not raised by Procedure Insert");
|
exception
|
exception
|
when Ada.Strings.Length_Error => null; -- OK, expected exception
|
when Ada.Strings.Length_Error => null; -- OK, expected exception
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception raised by Procedure Insert");
|
Report.Failed("Incorrect exception raised by Procedure Insert");
|
end;
|
end;
|
|
|
|
|
|
|
-- Function Overwrite
|
-- Function Overwrite
|
|
|
TC_Set_Name ("Overwrite");
|
TC_Set_Name ("Overwrite");
|
|
|
Overwrite_String := TC_Check (
|
Overwrite_String := TC_Check (
|
ASF.Overwrite(Result_String, -- 10 chars
|
ASF.Overwrite(Result_String, -- 10 chars
|
1, -- starting at pos=1
|
1, -- starting at pos=1
|
Source_String3(1..10)));
|
Source_String3(1..10)));
|
|
|
if Overwrite_String /= Source_String3(1..10) then
|
if Overwrite_String /= Source_String3(1..10) then
|
Report.Failed("Incorrect result from Function Overwrite - 1");
|
Report.Failed("Incorrect result from Function Overwrite - 1");
|
end if;
|
end if;
|
|
|
|
|
if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or
|
if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or
|
TC_Check (ASF.Overwrite("a", 1, "xyz"))
|
TC_Check (ASF.Overwrite("a", 1, "xyz"))
|
/= "xyz" or -- chars appended
|
/= "xyz" or -- chars appended
|
TC_Check (ASF.Overwrite("abc", 3, " "))
|
TC_Check (ASF.Overwrite("abc", 3, " "))
|
/= "ab " or -- blanks appended
|
/= "ab " or -- blanks appended
|
TC_Check (ASF.Overwrite("abcde", 1, "z" )) /= "zbcde"
|
TC_Check (ASF.Overwrite("abcde", 1, "z" )) /= "zbcde"
|
then
|
then
|
Report.Failed("Incorrect result from Function Overwrite - 2");
|
Report.Failed("Incorrect result from Function Overwrite - 2");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Procedure Overwrite, with truncation.
|
-- Procedure Overwrite, with truncation.
|
|
|
ASF.Overwrite(Source => Overwrite_String, -- 10 characters.
|
ASF.Overwrite(Source => Overwrite_String, -- 10 characters.
|
Position => 1,
|
Position => 1,
|
New_Item => Source_String3, -- 12 characters.
|
New_Item => Source_String3, -- 12 characters.
|
Drop => Ada.Strings.Left);
|
Drop => Ada.Strings.Left);
|
|
|
if Overwrite_String /= "cdefghijkl" then
|
if Overwrite_String /= "cdefghijkl" then
|
Report.Failed("Incorrect result from Overwrite with Drop=Left");
|
Report.Failed("Incorrect result from Overwrite with Drop=Left");
|
end if;
|
end if;
|
|
|
-- The default drop value is Right, used here.
|
-- The default drop value is Right, used here.
|
|
|
ASF.Overwrite(Source => Overwrite_String, -- 10 characters.
|
ASF.Overwrite(Source => Overwrite_String, -- 10 characters.
|
Position => 1,
|
Position => 1,
|
New_Item => Source_String3); -- 12 characters.
|
New_Item => Source_String3); -- 12 characters.
|
|
|
if Overwrite_String /= "abcdefghij" then
|
if Overwrite_String /= "abcdefghij" then
|
Report.Failed("Incorrect result from Overwrite with Drop=Right");
|
Report.Failed("Incorrect result from Overwrite with Drop=Right");
|
end if;
|
end if;
|
|
|
-- Drop = Error
|
-- Drop = Error
|
|
|
begin
|
begin
|
ASF.Overwrite(Source => Overwrite_String, -- 10 characters.
|
ASF.Overwrite(Source => Overwrite_String, -- 10 characters.
|
Position => 1,
|
Position => 1,
|
New_Item => Source_String3, -- 12 characters.
|
New_Item => Source_String3, -- 12 characters.
|
Drop => Ada.Strings.Error);
|
Drop => Ada.Strings.Error);
|
Report.Failed("Exception not raised by Procedure Overwrite");
|
Report.Failed("Exception not raised by Procedure Overwrite");
|
exception
|
exception
|
when Ada.Strings.Length_Error => null; -- OK, expected exception.
|
when Ada.Strings.Length_Error => null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed
|
Report.Failed
|
("Incorrect exception raised by Procedure Overwrite");
|
("Incorrect exception raised by Procedure Overwrite");
|
end;
|
end;
|
|
|
Overwrite_String := "ababababab";
|
Overwrite_String := "ababababab";
|
ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z");
|
ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z");
|
ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z");
|
ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z");
|
ASF.Overwrite(Overwrite_String, 5, "zz");
|
ASF.Overwrite(Overwrite_String, 5, "zz");
|
|
|
if Overwrite_String /= "zbabzzabaz" then
|
if Overwrite_String /= "zbabzzabaz" then
|
Report.Failed("Incorrect result from Procedure Overwrite");
|
Report.Failed("Incorrect result from Procedure Overwrite");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Function Delete
|
-- Function Delete
|
|
|
TC_Set_Name ("Delete");
|
TC_Set_Name ("Delete");
|
|
|
declare
|
declare
|
New_String1 : constant String := -- This returns a 4 char string.
|
New_String1 : constant String := -- This returns a 4 char string.
|
TC_Check (ASF.Delete(Source => Source_String3,
|
TC_Check (ASF.Delete(Source => Source_String3,
|
From => 3,
|
From => 3,
|
Through => 10));
|
Through => 10));
|
New_String2 : constant String := -- This returns Source.
|
New_String2 : constant String := -- This returns Source.
|
TC_Check (ASF.Delete(Source_String3, 10, 3));
|
TC_Check (ASF.Delete(Source_String3, 10, 3));
|
begin
|
begin
|
if New_String1 /= "abkl" or
|
if New_String1 /= "abkl" or
|
New_String2 /= Source_String3
|
New_String2 /= Source_String3
|
then
|
then
|
Report.Failed("Incorrect result from Function Delete - 1");
|
Report.Failed("Incorrect result from Function Delete - 1");
|
end if;
|
end if;
|
end;
|
end;
|
|
|
if TC_Check (ASF.Delete("a", 1, 1))
|
if TC_Check (ASF.Delete("a", 1, 1))
|
/= "" or -- Source length = 1
|
/= "" or -- Source length = 1
|
TC_Check (ASF.Delete("abc", 1, 2))
|
TC_Check (ASF.Delete("abc", 1, 2))
|
/= "c" or -- From = Source'First
|
/= "c" or -- From = Source'First
|
TC_Check (ASF.Delete("abc", 3, 3))
|
TC_Check (ASF.Delete("abc", 3, 3))
|
/= "ab" or -- From = Source'Last
|
/= "ab" or -- From = Source'Last
|
TC_Check (ASF.Delete("abc", 3, 1))
|
TC_Check (ASF.Delete("abc", 3, 1))
|
/= "abc" -- From > Through
|
/= "abc" -- From > Through
|
then
|
then
|
Report.Failed("Incorrect result from Function Delete - 2");
|
Report.Failed("Incorrect result from Function Delete - 2");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Procedure Delete
|
-- Procedure Delete
|
|
|
-- Justify = Left
|
-- Justify = Left
|
|
|
Delete_String := Source_String3(1..10); -- Initialize to "abcdefghij"
|
Delete_String := Source_String3(1..10); -- Initialize to "abcdefghij"
|
|
|
ASF.Delete(Source => Delete_String,
|
ASF.Delete(Source => Delete_String,
|
From => 6,
|
From => 6,
|
Through => Delete_String'Last,
|
Through => Delete_String'Last,
|
Justify => Ada.Strings.Left,
|
Justify => Ada.Strings.Left,
|
Pad => 'x'); -- pad with char 'x'
|
Pad => 'x'); -- pad with char 'x'
|
|
|
if Delete_String /= "abcdexxxxx" then
|
if Delete_String /= "abcdexxxxx" then
|
Report.Failed("Incorrect result from Delete - Justify = Left");
|
Report.Failed("Incorrect result from Delete - Justify = Left");
|
end if;
|
end if;
|
|
|
-- Justify = Right
|
-- Justify = Right
|
|
|
ASF.Delete(Source => Delete_String, -- Remove x"s from end and
|
ASF.Delete(Source => Delete_String, -- Remove x"s from end and
|
From => 6, -- shift right.
|
From => 6, -- shift right.
|
Through => Delete_String'Last,
|
Through => Delete_String'Last,
|
Justify => Ada.Strings.Right,
|
Justify => Ada.Strings.Right,
|
Pad => 'x'); -- pad with char 'x' on left.
|
Pad => 'x'); -- pad with char 'x' on left.
|
|
|
if Delete_String /= "xxxxxabcde" then
|
if Delete_String /= "xxxxxabcde" then
|
Report.Failed("Incorrect result from Delete - Justify = Right");
|
Report.Failed("Incorrect result from Delete - Justify = Right");
|
end if;
|
end if;
|
|
|
-- Justify = Center
|
-- Justify = Center
|
|
|
ASF.Delete(Source => Delete_String,
|
ASF.Delete(Source => Delete_String,
|
From => 1,
|
From => 1,
|
Through => 5,
|
Through => 5,
|
Justify => Ada.Strings.Center,
|
Justify => Ada.Strings.Center,
|
Pad => 'z');
|
Pad => 'z');
|
|
|
if Delete_String /= "zzabcdezzz" then -- extra pad char on right side.
|
if Delete_String /= "zzabcdezzz" then -- extra pad char on right side.
|
Report.Failed("Incorrect result from Delete - Justify = Center");
|
Report.Failed("Incorrect result from Delete - Justify = Center");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Function Trim
|
-- Function Trim
|
-- Use non-identity character sets to perform the trim operation.
|
-- Use non-identity character sets to perform the trim operation.
|
|
|
TC_Set_Name ("Trim");
|
TC_Set_Name ("Trim");
|
|
|
Trim_String := "cdabcdefcd";
|
Trim_String := "cdabcdefcd";
|
|
|
-- Remove the "cd" from each end of the string. This will not effect
|
-- Remove the "cd" from each end of the string. This will not effect
|
-- the "cd" slice at 5..6.
|
-- the "cd" slice at 5..6.
|
|
|
declare
|
declare
|
New_String : constant String :=
|
New_String : constant String :=
|
TC_Check (ASF.Trim(Source => Trim_String,
|
TC_Check (ASF.Trim(Source => Trim_String,
|
Left => CD_Set, Right => CD_Set));
|
Left => CD_Set, Right => CD_Set));
|
begin
|
begin
|
if New_String /= Source_String2 then -- string "abcdef"
|
if New_String /= Source_String2 then -- string "abcdef"
|
Report.Failed("Incorrect result from Trim with character sets");
|
Report.Failed("Incorrect result from Trim with character sets");
|
end if;
|
end if;
|
end;
|
end;
|
|
|
if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set))
|
if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set))
|
/= "abcdef" then
|
/= "abcdef" then
|
Report.Failed("Incorrect result from Trim with Null sets");
|
Report.Failed("Incorrect result from Trim with Null sets");
|
end if;
|
end if;
|
|
|
if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then
|
if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then
|
Report.Failed("Incorrect result from Trim, string removal");
|
Report.Failed("Incorrect result from Trim, string removal");
|
end if;
|
end if;
|
|
|
|
|
-- Procedure Trim
|
-- Procedure Trim
|
|
|
-- Justify = Right
|
-- Justify = Right
|
|
|
ASF.Trim(Source => Trim_String,
|
ASF.Trim(Source => Trim_String,
|
Left => CD_Set,
|
Left => CD_Set,
|
Right => CD_Set,
|
Right => CD_Set,
|
Justify => Ada.Strings.Right,
|
Justify => Ada.Strings.Right,
|
Pad => 'x');
|
Pad => 'x');
|
|
|
if Trim_String /= "xxxxabcdef" then
|
if Trim_String /= "xxxxabcdef" then
|
Report.Failed("Incorrect result from Trim with Justify = Right");
|
Report.Failed("Incorrect result from Trim with Justify = Right");
|
end if;
|
end if;
|
|
|
-- Justify = Left
|
-- Justify = Left
|
|
|
ASF.Trim(Source => Trim_String,
|
ASF.Trim(Source => Trim_String,
|
Left => X_Set,
|
Left => X_Set,
|
Right => Maps.Null_Set,
|
Right => Maps.Null_Set,
|
Justify => Ada.Strings.Left,
|
Justify => Ada.Strings.Left,
|
Pad => Ada.Strings.Space);
|
Pad => Ada.Strings.Space);
|
|
|
if Trim_String /= "abcdef " then -- Padded with 4 blanks on right.
|
if Trim_String /= "abcdef " then -- Padded with 4 blanks on right.
|
Report.Failed("Incorrect result from Trim with Justify = Left");
|
Report.Failed("Incorrect result from Trim with Justify = Left");
|
end if;
|
end if;
|
|
|
-- Justify = Center
|
-- Justify = Center
|
|
|
ASF.Trim(Source => Trim_String,
|
ASF.Trim(Source => Trim_String,
|
Left => ABCD_Set,
|
Left => ABCD_Set,
|
Right => CD_Set,
|
Right => CD_Set,
|
Justify => Ada.Strings.Center,
|
Justify => Ada.Strings.Center,
|
Pad => 'x');
|
Pad => 'x');
|
|
|
if Trim_String /= "xxef xx" then -- Padded with 2 pad chars on L/R
|
if Trim_String /= "xxef xx" then -- Padded with 2 pad chars on L/R
|
Report.Failed("Incorrect result from Trim with Justify = Center");
|
Report.Failed("Incorrect result from Trim with Justify = Center");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Function Head, demonstrating use of padding.
|
-- Function Head, demonstrating use of padding.
|
|
|
TC_Set_Name ("Head");
|
TC_Set_Name ("Head");
|
|
|
-- Use the characters of Source_String1 ("abcde") and pad the
|
-- Use the characters of Source_String1 ("abcde") and pad the
|
-- last five characters of Result_String with 'x' characters.
|
-- last five characters of Result_String with 'x' characters.
|
|
|
|
|
Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x'));
|
Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x'));
|
|
|
if Result_String /= "abcdexxxxx" then
|
if Result_String /= "abcdexxxxx" then
|
Report.Failed("Incorrect result from Function Head with padding");
|
Report.Failed("Incorrect result from Function Head with padding");
|
end if;
|
end if;
|
|
|
if TC_Check (ASF.Head(" ab ", 2)) /= " " or
|
if TC_Check (ASF.Head(" ab ", 2)) /= " " or
|
TC_Check (ASF.Head("a", 6, 'A')) /= "aAAAAA" or
|
TC_Check (ASF.Head("a", 6, 'A')) /= "aAAAAA" or
|
TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc" or
|
TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc" or
|
TC_Check (ASF.Head(ASF.Head("abc ", 7, 'x'), 10, 'X'))
|
TC_Check (ASF.Head(ASF.Head("abc ", 7, 'x'), 10, 'X'))
|
/= "abc xxXXX"
|
/= "abc xxXXX"
|
then
|
then
|
Report.Failed("Incorrect result from Function Head");
|
Report.Failed("Incorrect result from Function Head");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Function Tail, demonstrating use of padding.
|
-- Function Tail, demonstrating use of padding.
|
|
|
TC_Set_Name ("Tail");
|
TC_Set_Name ("Tail");
|
|
|
-- Use the characters of Source_String1 ("abcde") and pad the
|
-- Use the characters of Source_String1 ("abcde") and pad the
|
-- first five characters of Result_String with 'x' characters.
|
-- first five characters of Result_String with 'x' characters.
|
|
|
Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x'));
|
Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x'));
|
|
|
if Result_String /= "xxxxxabcde" then
|
if Result_String /= "xxxxxabcde" then
|
Report.Failed("Incorrect result from Function Tail with padding");
|
Report.Failed("Incorrect result from Function Tail with padding");
|
end if;
|
end if;
|
|
|
if TC_Check (ASF.Tail("abcde ", 5))
|
if TC_Check (ASF.Tail("abcde ", 5))
|
/= "cde " or -- blanks, back
|
/= "cde " or -- blanks, back
|
TC_Check (ASF.Tail(" abc ", 8, ' '))
|
TC_Check (ASF.Tail(" abc ", 8, ' '))
|
/= " abc " or -- blanks, front/back
|
/= " abc " or -- blanks, front/back
|
TC_Check (ASF.Tail("", 5, 'Z'))
|
TC_Check (ASF.Tail("", 5, 'Z'))
|
/= "ZZZZZ" or -- pad characters only
|
/= "ZZZZZ" or -- pad characters only
|
TC_Check (ASF.Tail("abc", 0))
|
TC_Check (ASF.Tail("abc", 0))
|
/= "" or -- null result
|
/= "" or -- null result
|
TC_Check (ASF.Tail("abcdefgh", 3))
|
TC_Check (ASF.Tail("abcdefgh", 3))
|
/= "fgh" or
|
/= "fgh" or
|
TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'),
|
TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'),
|
10,
|
10,
|
'X')) /= "XXXXx abc "
|
'X')) /= "XXXXx abc "
|
then
|
then
|
Report.Failed("Incorrect result from Function Tail");
|
Report.Failed("Incorrect result from Function Tail");
|
end if;
|
end if;
|
|
|
|
|
-- Function "*" - with (Natural, String) parameters
|
-- Function "*" - with (Natural, String) parameters
|
|
|
TC_Set_Name ("""*""");
|
TC_Set_Name ("""*""");
|
|
|
if TC_Check (ASF."*"(3, Source_String1)) /= "abcdeabcdeabcde" or
|
if TC_Check (ASF."*"(3, Source_String1)) /= "abcdeabcdeabcde" or
|
TC_Check (ASF."*"(2, Source_String2)) /= Source_String6 or
|
TC_Check (ASF."*"(2, Source_String2)) /= Source_String6 or
|
TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab" or
|
TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab" or
|
TC_Check (ASF."*"(0, Source_String1)) /= ""
|
TC_Check (ASF."*"(0, Source_String1)) /= ""
|
then
|
then
|
Report.Failed("Incorrect result from Function ""*"" with strings");
|
Report.Failed("Incorrect result from Function ""*"" with strings");
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when others => Report.Failed("Exception raised in Test_Block");
|
when others => Report.Failed("Exception raised in Test_Block");
|
end Test_Block;
|
end Test_Block;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end CXA4005;
|
end CXA4005;
|
|
|