diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxa4005.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxa/cxa4005.a | 683 |
1 files changed, 0 insertions, 683 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a deleted file mode 100644 index d61f853ca0e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a +++ /dev/null @@ -1,683 +0,0 @@ --- CXA4005.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 the subprograms defined in package Ada.Strings.Fixed are --- available, and that they produce correct results. Specifically, --- check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice, --- Tail, Trim, and "*". --- --- TEST DESCRIPTION: --- This test, when combined with tests CXA4002-4 will provide coverage --- of the functionality found in Ada.Strings.Fixed. --- This test contains many small, specific test cases, situations that --- although common in user environments, are often difficult to generate --- in large numbers in a application-based test. They represent --- individual usage paradigms in-the-small. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 11 Apr 95 SAIC Corrected acceptance conditions of certain --- subtests. --- 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. --- 13 Mar 01 RLB Fixed a couple of ACATS style violations; --- removed pointless checks of procedures. --- Added checks of other functions. These changes --- were made to test Defect Report 8652/0049, as --- reflected in Technical Corrigendum 1. --- ---! - -with Report; -with Ada.Strings; -with Ada.Strings.Fixed; -with Ada.Strings.Maps; - -procedure CXA4005 is - - type TC_Name_Holder is access String; - Name : TC_Name_Holder; - - function TC_Check (S : String) return String is - begin - if S'First /= 1 then - Report.Failed ("Lower bound of result of function " & Name.all & - " is" & Integer'Image (S'First)); - end if; - return S; - end TC_Check; - - procedure TC_Set_Name (N : String) is - begin - Name := new String'(N); - end TC_Set_Name; - -begin - - Report.Test("CXA4005", "Check that the subprograms defined in " & - "package Ada.Strings.Fixed are available, " & - "and that they produce correct results"); - - Test_Block: - declare - - package ASF renames Ada.Strings.Fixed; - package Maps renames Ada.Strings.Maps; - - Result_String, - Delete_String, - Insert_String, - Trim_String, - Overwrite_String : String(1..10) := (others => Ada.Strings.Space); - - Source_String1 : String(1..5) := "abcde"; -- odd length string - Source_String2 : String(1..6) := "abcdef"; -- even length string - Source_String3 : String(1..12) := "abcdefghijkl"; - Source_String4 : String(1..12) := "abcdefghij "; -- last two ch pad - Source_String5 : String(1..12) := " cdefghijkl"; -- first two ch pad - Source_String6 : String(1..12) := "abcdefabcdef"; - - Location : Natural := 0; - Slice_Start : Positive; - Slice_End, - Slice_Count : Natural := 0; - - CD_Set : Maps.Character_Set := Maps.To_Set("cd"); - X_Set : Maps.Character_Set := Maps.To_Set('x'); - ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd"); - A_to_F_Set : Maps.Character_Set := Maps.To_Set("abcdef"); - - CD_to_XY_Map : Maps.Character_Mapping := - Maps.To_Mapping(From => "cd", To => "xy"); - - begin - - -- Procedure Replace_Slice - -- The functionality of this procedure - -- is similar to procedure Move, and - -- is tested here in the same manner, evaluated - -- with various combinations of parameters. - - -- Index_Error propagation when Low > Source'Last + 1 - - begin - ASF.Replace_Slice(Result_String, - Result_String'Last + 2, -- should raise exception - Result_String'Last, - "xxxxxxx"); - Report.Failed("Index_Error not raised by Replace_Slice - 1"); - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Replace_Slice - 1"); - end; - - -- Index_Error propagation when High < Source'First - 1 - - begin - ASF.Replace_Slice(Result_String(5..10), - 5, - 3, -- should raise exception since < 'First - 1. - "xxxxxxx"); - Report.Failed("Index_Error not raised by Replace_Slice - 2"); - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Replace_Slice - 2"); - end; - - -- Justify = Left (default case) - - Result_String := "XXXXXXXXXX"; - - ASF.Replace_Slice(Source => Result_String, - Low => 1, - High => 10, - By => Source_String1); -- "abcde" - - if Result_String /= "abcde " then - Report.Failed("Incorrect result from Replace_Slice - Justify = Left"); - end if; - - -- Justify = Right - - ASF.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String2, -- "abcdef" - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Right); - - if Result_String /= " abcdef" then - Report.Failed("Incorrect result from Replace_Slice - Justify=Right"); - end if; - - -- Justify = Center (two cases, odd and even pad lengths) - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String1, -- "abcde" - Ada.Strings.Error, - Ada.Strings.Center, - 'x'); -- non-default padding. - - if Result_String /= "xxabcdexxx" then -- Unequal padding added right - Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1"); - end if; - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String2, -- "abcdef" - Ada.Strings.Error, - Ada.Strings.Center); - - if Result_String /= " abcdef " then -- Equal padding added on L/R. - Report.Failed("Incorrect result from Replace_Slice with " & - "Justify = Center - 2"); - end if; - - -- When the source string is longer than the target string, several - -- cases can be examined, with the results depending on the value of - -- the Drop parameter. - - -- Drop = Left - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String3, -- "abcdefghijkl" - Drop => Ada.Strings.Left); - - if Result_String /= "cdefghijkl" then - Report.Failed("Incorrect result from Replace_Slice - Drop=Left"); - end if; - - -- Drop = Right - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String3, -- "abcdefghijkl" - Ada.Strings.Right); - - if Result_String /= "abcdefghij" then - Report.Failed("Incorrect result, Replace_Slice with Drop=Right"); - end if; - - -- Drop = Error - - -- The effect in this case depends on the value of the justify - -- parameter, and on whether any characters in Source other than - -- Pad would fail to be copied. - - -- Drop = Error, Justify = Left, right overflow characters are pad. - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String4, -- "abcdefghij " - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Left); - - if not(Result_String = "abcdefghij") then -- leftmost 10 characters - Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1"); - end if; - - -- Drop = Error, Justify = Right, left overflow characters are pad. - - ASF.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String5, -- " cdefghijkl" - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Right); - - if Result_String /= "cdefghijkl" then -- rightmost 10 characters - Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2"); - end if; - - -- In other cases of Drop=Error, Length_Error is propagated, such as: - - begin - - ASF.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String3, -- "abcdefghijkl" - Drop => Ada.Strings.Error); - - Report.Failed("Length_Error not raised by Replace_Slice - 1"); - - exception - when Ada.Strings.Length_Error => null; -- OK - when others => - Report.Failed("Incorrect exception from Replace_Slice - 3"); - end; - - - -- Function Replace_Slice - - TC_Set_Name ("Replace_Slice"); - - if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x")) - /= "abxde" or -- High = Low - TC_Check (ASF.Replace_Slice("abc", 2, 3, "xyz")) /= "axyz" or - TC_Check (ASF.Replace_Slice("abcd", 4, 1, "xy")) - /= "abcxyd" or -- High < Low - TC_Check (ASF.Replace_Slice("abc", 2, 3, "x")) /= "ax" or - TC_Check (ASF.Replace_Slice("a", 1, 1, "z")) /= "z" - then - Report.Failed("Incorrect result from Function Replace_Slice - 1"); - end if; - - if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z")) - /= "abcdz" or -- By length 1 - TC_Check (ASF.Replace_Slice("abc", 1, 3, "xyz")) - /= "xyz" or -- High > Low - TC_Check (ASF.Replace_Slice("abc", 3, 2, "xy")) - /= "abxyc" or -- insert - TC_Check (ASF.Replace_Slice("a", 1, 1, "xyz")) /= "xyz" - then - Report.Failed("Incorrect result from Function Replace_Slice - 2"); - end if; - - - - -- Function Insert. - - TC_Set_Name ("Insert"); - - declare - New_String : constant String := - TC_Check ( - ASF.Insert(Source => Source_String1(2..5), -- "bcde" - Before => 3, - New_Item => Source_String2)); -- "abcdef" - begin - if New_String /= "babcdefcde" then - Report.Failed("Incorrect result from Function Insert - 1"); - end if; - end; - - if TC_Check (ASF.Insert("a", 1, "z")) /= "za" or - TC_Check (ASF.Insert("abc", 3, "")) /= "abc" or - TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc" - then - Report.Failed("Incorrect result from Function Insert - 2"); - end if; - - begin - if TC_Check (ASF.Insert(Source => Source_String1(2..5), -- "bcde" - Before => Report.Ident_Int(7), - New_Item => Source_String2)) -- "abcdef" - /= "babcdefcde" then - Report.Failed("Index_Error not raised by Insert - 3A"); - else - Report.Failed("Index_Error not raised by Insert - 3B"); - end if; - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Insert - 3"); - end; - - - -- Procedure Insert - - -- Drop = Right - - ASF.Insert(Source => Insert_String, - Before => 6, - New_Item => Source_String2, -- "abcdef" - Drop => Ada.Strings.Right); - - if Insert_String /= " abcde" then -- last char of New_Item dropped. - Report.Failed("Incorrect result from Insert with Drop = Right"); - end if; - - -- Drop = Left - - ASF.Insert(Source => Insert_String, -- 10 char string - Before => 2, -- 9 chars, 2..10 available - New_Item => Source_String3, -- 12 characters long. - Drop => Ada.Strings.Left); -- truncate from Left. - - if Insert_String /= "l abcde" then -- 10 chars, leading blank. - Report.Failed("Incorrect result from Insert with Drop=Left"); - end if; - - -- Drop = Error - - begin - ASF.Insert(Source => Result_String, -- 10 chars - Before => Result_String'Last, - New_Item => "abcdefghijk", - Drop => Ada.Strings.Error); - Report.Failed("Exception not raised by Procedure Insert"); - exception - when Ada.Strings.Length_Error => null; -- OK, expected exception - when others => - Report.Failed("Incorrect exception raised by Procedure Insert"); - end; - - - - -- Function Overwrite - - TC_Set_Name ("Overwrite"); - - Overwrite_String := TC_Check ( - ASF.Overwrite(Result_String, -- 10 chars - 1, -- starting at pos=1 - Source_String3(1..10))); - - if Overwrite_String /= Source_String3(1..10) then - Report.Failed("Incorrect result from Function Overwrite - 1"); - end if; - - - if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or - TC_Check (ASF.Overwrite("a", 1, "xyz")) - /= "xyz" or -- chars appended - TC_Check (ASF.Overwrite("abc", 3, " ")) - /= "ab " or -- blanks appended - TC_Check (ASF.Overwrite("abcde", 1, "z" )) /= "zbcde" - then - Report.Failed("Incorrect result from Function Overwrite - 2"); - end if; - - - - -- Procedure Overwrite, with truncation. - - ASF.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3, -- 12 characters. - Drop => Ada.Strings.Left); - - if Overwrite_String /= "cdefghijkl" then - Report.Failed("Incorrect result from Overwrite with Drop=Left"); - end if; - - -- The default drop value is Right, used here. - - ASF.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3); -- 12 characters. - - if Overwrite_String /= "abcdefghij" then - Report.Failed("Incorrect result from Overwrite with Drop=Right"); - end if; - - -- Drop = Error - - begin - ASF.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3, -- 12 characters. - Drop => Ada.Strings.Error); - Report.Failed("Exception not raised by Procedure Overwrite"); - exception - when Ada.Strings.Length_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Incorrect exception raised by Procedure Overwrite"); - end; - - Overwrite_String := "ababababab"; - ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z"); - ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z"); - ASF.Overwrite(Overwrite_String, 5, "zz"); - - if Overwrite_String /= "zbabzzabaz" then - Report.Failed("Incorrect result from Procedure Overwrite"); - end if; - - - - -- Function Delete - - TC_Set_Name ("Delete"); - - declare - New_String1 : constant String := -- This returns a 4 char string. - TC_Check (ASF.Delete(Source => Source_String3, - From => 3, - Through => 10)); - New_String2 : constant String := -- This returns Source. - TC_Check (ASF.Delete(Source_String3, 10, 3)); - begin - if New_String1 /= "abkl" or - New_String2 /= Source_String3 - then - Report.Failed("Incorrect result from Function Delete - 1"); - end if; - end; - - if TC_Check (ASF.Delete("a", 1, 1)) - /= "" or -- Source length = 1 - TC_Check (ASF.Delete("abc", 1, 2)) - /= "c" or -- From = Source'First - TC_Check (ASF.Delete("abc", 3, 3)) - /= "ab" or -- From = Source'Last - TC_Check (ASF.Delete("abc", 3, 1)) - /= "abc" -- From > Through - then - Report.Failed("Incorrect result from Function Delete - 2"); - end if; - - - - -- Procedure Delete - - -- Justify = Left - - Delete_String := Source_String3(1..10); -- Initialize to "abcdefghij" - - ASF.Delete(Source => Delete_String, - From => 6, - Through => Delete_String'Last, - Justify => Ada.Strings.Left, - Pad => 'x'); -- pad with char 'x' - - if Delete_String /= "abcdexxxxx" then - Report.Failed("Incorrect result from Delete - Justify = Left"); - end if; - - -- Justify = Right - - ASF.Delete(Source => Delete_String, -- Remove x"s from end and - From => 6, -- shift right. - Through => Delete_String'Last, - Justify => Ada.Strings.Right, - Pad => 'x'); -- pad with char 'x' on left. - - if Delete_String /= "xxxxxabcde" then - Report.Failed("Incorrect result from Delete - Justify = Right"); - end if; - - -- Justify = Center - - ASF.Delete(Source => Delete_String, - From => 1, - Through => 5, - Justify => Ada.Strings.Center, - Pad => 'z'); - - if Delete_String /= "zzabcdezzz" then -- extra pad char on right side. - Report.Failed("Incorrect result from Delete - Justify = Center"); - end if; - - - - -- Function Trim - -- Use non-identity character sets to perform the trim operation. - - TC_Set_Name ("Trim"); - - Trim_String := "cdabcdefcd"; - - -- Remove the "cd" from each end of the string. This will not effect - -- the "cd" slice at 5..6. - - declare - New_String : constant String := - TC_Check (ASF.Trim(Source => Trim_String, - Left => CD_Set, Right => CD_Set)); - begin - if New_String /= Source_String2 then -- string "abcdef" - Report.Failed("Incorrect result from Trim with character sets"); - end if; - end; - - if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set)) - /= "abcdef" then - Report.Failed("Incorrect result from Trim with Null sets"); - end if; - - if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then - Report.Failed("Incorrect result from Trim, string removal"); - end if; - - - -- Procedure Trim - - -- Justify = Right - - ASF.Trim(Source => Trim_String, - Left => CD_Set, - Right => CD_Set, - Justify => Ada.Strings.Right, - Pad => 'x'); - - if Trim_String /= "xxxxabcdef" then - Report.Failed("Incorrect result from Trim with Justify = Right"); - end if; - - -- Justify = Left - - ASF.Trim(Source => Trim_String, - Left => X_Set, - Right => Maps.Null_Set, - Justify => Ada.Strings.Left, - Pad => Ada.Strings.Space); - - if Trim_String /= "abcdef " then -- Padded with 4 blanks on right. - Report.Failed("Incorrect result from Trim with Justify = Left"); - end if; - - -- Justify = Center - - ASF.Trim(Source => Trim_String, - Left => ABCD_Set, - Right => CD_Set, - Justify => Ada.Strings.Center, - Pad => 'x'); - - if Trim_String /= "xxef xx" then -- Padded with 2 pad chars on L/R - Report.Failed("Incorrect result from Trim with Justify = Center"); - end if; - - - - -- Function Head, demonstrating use of padding. - - TC_Set_Name ("Head"); - - -- Use the characters of Source_String1 ("abcde") and pad the - -- last five characters of Result_String with 'x' characters. - - - Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x')); - - if Result_String /= "abcdexxxxx" then - Report.Failed("Incorrect result from Function Head with padding"); - end if; - - if TC_Check (ASF.Head(" ab ", 2)) /= " " or - TC_Check (ASF.Head("a", 6, 'A')) /= "aAAAAA" or - TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc" or - TC_Check (ASF.Head(ASF.Head("abc ", 7, 'x'), 10, 'X')) - /= "abc xxXXX" - then - Report.Failed("Incorrect result from Function Head"); - end if; - - - - -- Function Tail, demonstrating use of padding. - - TC_Set_Name ("Tail"); - - -- Use the characters of Source_String1 ("abcde") and pad the - -- first five characters of Result_String with 'x' characters. - - Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x')); - - if Result_String /= "xxxxxabcde" then - Report.Failed("Incorrect result from Function Tail with padding"); - end if; - - if TC_Check (ASF.Tail("abcde ", 5)) - /= "cde " or -- blanks, back - TC_Check (ASF.Tail(" abc ", 8, ' ')) - /= " abc " or -- blanks, front/back - TC_Check (ASF.Tail("", 5, 'Z')) - /= "ZZZZZ" or -- pad characters only - TC_Check (ASF.Tail("abc", 0)) - /= "" or -- null result - TC_Check (ASF.Tail("abcdefgh", 3)) - /= "fgh" or - TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'), - 10, - 'X')) /= "XXXXx abc " - then - Report.Failed("Incorrect result from Function Tail"); - end if; - - - -- Function "*" - with (Natural, String) parameters - - TC_Set_Name ("""*"""); - - if TC_Check (ASF."*"(3, Source_String1)) /= "abcdeabcdeabcde" or - TC_Check (ASF."*"(2, Source_String2)) /= Source_String6 or - TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab" or - TC_Check (ASF."*"(0, Source_String1)) /= "" - then - Report.Failed("Incorrect result from Function ""*"" with strings"); - end if; - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4005; |