From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/cxa/cxa4004.a | 431 ++++++++++++++++++++++++++++ 1 file changed, 431 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cxa/cxa4004.a (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxa4004.a') diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a new file mode 100644 index 000000000..ec11f7d50 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a @@ -0,0 +1,431 @@ +-- CXA4004.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 Count, Find_Token, Index, Index_Non_Blank, and Move. +-- +-- TEST DESCRIPTION: +-- This test, when combined with tests CXA4002,3, and 5 will provide +-- thorough 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. +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- 10 Apr 95 SAIC Corrected subtest for Move, Drop=Right. +-- +--! + +with Report; +with Ada.Strings; +with Ada.Strings.Fixed; +with Ada.Strings.Maps; + +procedure CXA4004 is +begin + + Report.Test("CXA4004", "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 : 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"); + 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 Move + + -- Evaluate the Procedure Move with various combinations of + -- parameters. + + -- Justify = Left (default case) + + ASF.Move(Source => Source_String1, -- "abcde" + Target => Result_String); + + if Result_String /= "abcde " then + Report.Failed("Incorrect result from Move with Justify = Left"); + end if; + + -- Justify = Right + + ASF.Move(Source => Source_String2, -- "abcdef" + Target => Result_String, + Drop => Ada.Strings.Error, + Justify => Ada.Strings.Right); + + if Result_String /= " abcdef" then + Report.Failed("Incorrect result from Move with Justify = Right"); + end if; + + -- Justify = Center (two cases, odd and even pad lengths) + + ASF.Move(Source_String1, -- "abcde" + Result_String, + Ada.Strings.Error, + Ada.Strings.Center, + 'x'); -- non-default padding. + + if Result_String /= "xxabcdexxx" then -- Unequal padding added right + Report.Failed("Incorrect result from Move with Justify = Center-1"); + end if; + + ASF.Move(Source_String2, -- "abcdef" + Result_String, + Ada.Strings.Error, + Ada.Strings.Center); + + if Result_String /= " abcdef " then -- Equal padding added on L/R. + Report.Failed("Incorrect result from Move 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.Move(Source => Source_String3, -- "abcdefghijkl" + Target => Result_String, + Drop => Ada.Strings.Left); + + if Result_String /= "cdefghijkl" then + Report.Failed("Incorrect result from Move with Drop = Left"); + end if; + + -- Drop = Right + + ASF.Move(Source_String3, Result_String, Ada.Strings.Right); + + if Result_String /= "abcdefghij" then + Report.Failed("Incorrect result from Move 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.Move(Source => Source_String4, -- "abcdefghij " + Target => Result_String, + Drop => Ada.Strings.Error, + Justify => Ada.Strings.Left); + + if not(Result_String = "abcdefghij") then -- leftmost 10 characters + Report.Failed("Incorrect result from Move with Drop = Error - 1"); + end if; + + -- Drop = Error, Justify = Right, left overflow characters are pad. + + ASF.Move(Source_String5, -- " cdefghijkl" + Result_String, + Ada.Strings.Error, + Ada.Strings.Right); + + if Result_String /= "cdefghijkl" then -- rightmost 10 characters + Report.Failed("Incorrect result from Move with Drop = Error - 2"); + end if; + + -- In other cases of Drop=Error, Length_Error is propagated, such as: + + begin + + ASF.Move(Source_String3, -- 12 characters, no Pad. + Result_String, -- 10 characters + Ada.Strings.Error, + Ada.Strings.Left); + + Report.Failed("Length_Error not raised by Move - 1"); + + exception + when Ada.Strings.Length_Error => null; -- OK + when others => + Report.Failed("Incorrect exception raised by Move - 1"); + end; + + + + -- Function Index + -- (Other usage examples of this function found in CXA4002-3.) + -- Check when the pattern is not found in the source. + + if ASF.Index("abcdef", "gh") /= 0 or + ASF.Index("abcde", "abcdef") /= 0 or -- pattern > source + ASF.Index("xyz", + "abcde", + Ada.Strings.Backward) /= 0 or + ASF.Index("", "ab") /= 0 or -- null source string. + ASF.Index("abcde", " ") /= 0 -- blank pattern. + then + Report.Failed("Incorrect result from Index, no pattern match"); + end if; + + -- Check that Pattern_Error is raised when the pattern is the + -- null string. + begin + Location := ASF.Index(Source_String6, -- "abcdefabcdef" + "", -- null pattern string. + Ada.Strings.Forward); + Report.Failed("Pattern_Error not raised by Index"); + exception + when Ada.Strings.Pattern_Error => null; -- OK, expected exception. + when others => + Report.Failed("Incorrect exception raised by Index, null pattern"); + end; + + -- Use the search direction "backward" to locate the particular + -- pattern within the source string. + + Location := ASF.Index(Source_String6, -- "abcdefabcdef" + "de", -- slice 4..5, 10..11 + Ada.Strings.Backward); -- search from right end. + + if Location /= 10 then + Report.Failed("Incorrect result from Index going Backward"); + end if; + + -- Using the version of Index testing character set membership, + -- check combinations of forward/backward, inside/outside parameter + -- configurations. + + if ASF.Index(Source => Source_String1, -- "abcde" + Set => CD_Set, + Test => Ada.Strings.Inside, + Going => Ada.Strings.Forward) /= 3 or -- 'c' at pos 3. + ASF.Index(Source_String6, -- "abcdefabcdef" + CD_Set, + Ada.Strings.Outside, + Ada.Strings.Backward) /= 12 or -- 'f' at position 12 + ASF.Index(Source_String6, -- "abcdefabcdef" + CD_Set, + Ada.Strings.Inside, + Ada.Strings.Backward) /= 10 or -- 'd' at position 10 + ASF.Index("cdcdcdcdacdcdcdcd", + CD_Set, + Ada.Strings.Outside, + Ada.Strings.Forward) /= 9 -- 'a' at position 9 + then + Report.Failed("Incorrect result from function Index for sets - 1"); + end if; + + -- Additional interesting uses/combinations using Index for sets. + + if ASF.Index("cd", -- same size, str-set + CD_Set, + Ada.Strings.Inside, + Ada.Strings.Forward) /= 1 or -- 'c' at position 1 + ASF.Index("abcd", -- same size, str-set, + Maps.To_Set("efgh"), -- different contents. + Ada.Strings.Outside, + Ada.Strings.Forward) /= 1 or + ASF.Index("abccd", -- set > string + Maps.To_Set("acegik"), + Ada.Strings.Inside, + Ada.Strings.Backward) /= 4 or -- 'c' at position 4 + ASF.Index("abcde", + Maps.Null_Set) /= 0 or + ASF.Index("", -- Null string. + CD_Set) /= 0 or + ASF.Index("abc ab", -- blank included + Maps.To_Set("e "), -- in string and set. + Ada.Strings.Inside, + Ada.Strings.Backward) /= 4 -- blank in string. + then + Report.Failed("Incorrect result from function Index for sets - 2"); + end if; + + + + -- Function Index_Non_Blank. + -- (Other usage examples of this function found in CXA4002-3.) + + + if ASF.Index_Non_Blank(Source => Source_String4, -- "abcdefghij " + Going => Ada.Strings.Backward) /= 10 or + ASF.Index_Non_Blank("abc def ghi jkl ", + Ada.Strings.Backward) /= 15 or + ASF.Index_Non_Blank(" abcdef") /= 3 or + ASF.Index_Non_Blank(" ") /= 0 + then + Report.Failed("Incorrect result from Index_Non_Blank"); + end if; + + + + -- Function Count + -- (Other usage examples of this function found in CXA4002-3.) + + if ASF.Count("abababa", "aba") /= 2 or + ASF.Count("abababa", "ab" ) /= 3 or + ASF.Count("babababa", "ab") /= 3 or + ASF.Count("abaabaaba", "aba") /= 3 or + ASF.Count("xxxxxxxxxxxxxxxxxxxy", "xy") /= 1 or + ASF.Count("xxxxxxxxxxxxxxxxxxxx", "x") /= 20 + then + Report.Failed("Incorrect result from Function Count"); + end if; + + -- Determine the number of slices of Source that when mapped to a + -- non-identity map, match the pattern string. + + Slice_Count := ASF.Count(Source_String6, -- "abcdefabcdef" + "xy", + CD_to_XY_Map); -- maps 'c' to 'x', 'd' to 'y' + + if Slice_Count /= 2 then -- two slices "xy" in "mapped" Source_String6 + Report.Failed("Incorrect result from Count with non-identity map"); + end if; + + -- If the pattern supplied to Function Count is the null string, then + -- Pattern_Error is propagated. + + declare + The_Null_String : constant String := ""; + begin + Slice_Count := ASF.Count(Source_String6, The_Null_String); + Report.Failed("Pattern_Error not raised by Function Count"); + exception + when Ada.Strings.Pattern_Error => null; -- OK + when others => + Report.Failed("Incorrect exception from Count with null pattern"); + end; + + + -- Function Count returning the number of characters in a particular + -- set that are found in source string. + + if ASF.Count(Source_String6, CD_Set) /= 4 then -- 2 'c' and 'd' chars. + Report.Failed("Incorrect result from Count with set"); + end if; + + + + -- Function Find_Token. + -- (Other usage examples of this function found in CXA4002-3.) + + ASF.Find_Token(Source => Source_String6, -- First slice with no + Set => ABCD_Set, -- 'a', 'b', 'c', or 'd' + Test => Ada.Strings.Outside, -- is "ef" at 5..6. + First => Slice_Start, + Last => Slice_End); + + if Slice_Start /= 5 or Slice_End /= 6 then + Report.Failed("Incorrect result from Find_Token - 1"); + end if; + + -- If no appropriate slice is contained by the source string, then the + -- value returned in Last is zero, and the value in First is + -- Source'First. + + ASF.Find_Token(Source_String6, -- "abcdefabcdef" + A_to_F_Set, -- Set of characters 'a' thru 'f'. + Ada.Strings.Outside, -- No characters outside this set. + Slice_Start, + Slice_End); + + if Slice_Start /= Source_String6'First or Slice_End /= 0 then + Report.Failed("Incorrect result from Find_Token - 2"); + end if; + + -- Additional testing of Find_Token. + + ASF.Find_Token("eabcdabcddcab", + ABCD_Set, + Ada.Strings.Inside, + Slice_Start, + Slice_End); + + if Slice_Start /= 2 or Slice_End /= 13 then + Report.Failed("Incorrect result from Find_Token - 3"); + end if; + + ASF.Find_Token("efghijklabcdabcd", + ABCD_Set, + Ada.Strings.Outside, + Slice_Start, + Slice_End); + + if Slice_Start /= 1 or Slice_End /= 8 then + Report.Failed("Incorrect result from Find_Token - 4"); + end if; + + ASF.Find_Token("abcdefgabcdabcd", + ABCD_Set, + Ada.Strings.Outside, + Slice_Start, + Slice_End); + + if Slice_Start /= 5 or Slice_End /= 7 then + Report.Failed("Incorrect result from Find_Token - 5"); + end if; + + ASF.Find_Token("abcdcbabcdcba", + ABCD_Set, + Ada.Strings.Inside, + Slice_Start, + Slice_End); + + if Slice_Start /= 1 or Slice_End /= 13 then + Report.Failed("Incorrect result from Find_Token - 6"); + end if; + + + exception + when others => Report.Failed("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXA4004; -- cgit v1.2.3