obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

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.

1 files changed, 342 insertions, 0 deletions

diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a
new file mode 100644
index 000000000..05c66d4cc
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a
@@ -0,0 +1,342 @@
+-- CXA4027.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 versions of Ada.Strings.Bounded subprograms Translate,
+--      (procedure and function), Index, and Count, which use the 
+--      Maps.Character_Mapping_Function input parameter, produce correct 
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test examines the operation of several subprograms from within 
+--      the Ada.Strings.Bounded package that use the 
+--      Character_Mapping_Function mapping parameter to provide a mapping
+--      capability.
+--      
+--      Two functions are defined to provide the mapping.  Access values 
+--      are defined to refer to these functions.  One of the functions will
+--      map upper case characters in the range 'A'..'Z' to their lower case
+--      counterparts, while the other function will map lower case characters
+--      ('a'..'z', or a character whose position is in one of the ranges 
+--      223..246 or 248..255, provided the character has an upper case form)
+--      to their upper case form.
+--      
+--      Function Index uses the mapping function access value to map the input
+--      string prior to searching for the appropriate index value to return.
+--      Function Count uses the mapping function access value to map the input
+--      string prior to counting the occurrences of the pattern string.
+--      Both the Procedure and Function version of Translate use the mapping
+--      function access value to perform the translation.
+--
+--      
+-- CHANGE HISTORY:
+--      16 FEB 95   SAIC    Initial prerelease version
+--      17 Jul 95   SAIC    Incorporated reviewer comments.  Replaced two 
+--                          internally declared functions with two library
+--                          level functions to eliminate accessibility
+--                          problems.
+--
+--!
+
+
+-- Function CXA4027_0 will return the lower case form of 
+-- the character input if it is in upper case, and return the input
+-- character otherwise.
+
+with Ada.Characters.Handling;
+function CXA4027_0 (From : Character) return Character;
+
+function CXA4027_0 (From : Character) return Character is
+begin
+   return Ada.Characters.Handling.To_Lower(From);
+end CXA4027_0;
+
+
+
+-- Function CXA4027_1 will return the upper case form of 
+-- Characters in the range 'a'..'z', or whose position is in one
+-- of the ranges 223..246 or 248..255, provided the character has
+-- an upper case form.
+
+with Ada.Characters.Handling;
+function CXA4027_1 (From : Character) return Character;
+
+function CXA4027_1 (From : Character) return Character is
+begin
+   return Ada.Characters.Handling.To_Upper(From);
+end CXA4027_1;
+
+
+with CXA4027_0, CXA4027_1;
+with Ada.Strings.Bounded;
+with Ada.Strings.Maps;
+with Ada.Characters.Handling;
+with Report;
+
+procedure CXA4027 is
+begin
+
+   Report.Test ("CXA4027", "Check that Ada.Strings.Bounded subprograms "  &
+                           "Translate, Index, and Count, which use the "  &
+                           "Character_Mapping_Function input parameter, " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Strings;
+
+      -- Functions used to supply mapping capability.
+
+      function Map_To_Lower_Case (From : Character) return Character 
+        renames CXA4027_0; 
+
+      function Map_To_Upper_Case (From : Character) return Character
+        renames CXA4027_1; 
+
+      Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
+                                Map_To_Lower_Case'Access;
+
+      Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
+                                Map_To_Upper_Case'Access;
+
+
+      -- Instantiations of Bounded String generic package.
+
+      package BS1  is new Ada.Strings.Bounded.Generic_Bounded_Length(1);
+      package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20);
+      package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40);
+      package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
+
+      use type BS1.Bounded_String,  BS20.Bounded_String, 
+               BS40.Bounded_String, BS80.Bounded_String;
+
+      String_1   : String(1..1)  := "A";
+      String_20  : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
+      String_40  : String(1..40) := "abcdefghijklmnopqrst" & String_20;
+      String_80  : String(1..80) := String_40 & String_40;
+
+      BString_1  : BS1.Bounded_String  := BS1.Null_Bounded_String;
+      BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String;
+      BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String;
+      BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String;
+
+
+   begin
+
+      -- Function Index.
+
+      if BS40.Index(BS40.To_Bounded_String("Package Strings.Bounded"),
+                    Pattern => "s.b",
+                    Going   => Ada.Strings.Forward,
+                    Mapping => Map_To_Lower_Case_Ptr)     /= 15  or
+         BS80.Index(BS80.To_Bounded_String("STRING TRANSLATIONS SUBPROGRAMS"),
+                    "tr",
+                    Mapping => Map_To_Lower_Case_Ptr)     /= 2   or
+         BS20.Index(BS20.To_Bounded_String("maximum number"),
+                    "um",
+                    Ada.Strings.Backward,
+                    Map_To_Lower_Case_Ptr)                /= 10  or
+         BS80.Index(BS80.To_Bounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),
+                    "MIXED CASE STRING",
+                    Ada.Strings.Forward,
+                    Map_To_Upper_Case_Ptr)                /= 12  or
+         BS40.Index(BS40.To_Bounded_String("STRING WITH NO MATCHING PATTERN"),
+                    "WITH",
+                    Ada.Strings.Backward,
+                    Map_To_Lower_Case_Ptr)                /= 0   or
+         BS80.Index(BS80.To_Bounded_String("THIS STRING IS IN UPPER CASE"),
+                    "I",
+                    Ada.Strings.Backward,
+                    Map_To_Upper_Case_Ptr)                /= 16  or
+         BS1.Index(BS1.Null_Bounded_String,
+                   "i",
+                   Mapping => Map_To_Lower_Case_Ptr)      /= 0   or
+         BS40.Index(BS40.To_Bounded_String("AAABBBaaabbb"),
+                    "aabb",
+                    Mapping => Map_To_Lower_Case_Ptr)     /= 2   or
+         BS80.Index(BS80.To_Bounded_String("WOULD MATCH BUT FOR THE CASE"),
+                    "WOULD MATCH BUT FOR THE CASE",
+                    Ada.Strings.Backward,
+                    Map_To_Lower_Case_Ptr)                /= 0
+      then
+         Report.Failed("Incorrect results from Function Index, using a " &
+                       "Character Mapping Function parameter");
+      end if;
+
+
+      -- Function Index, Pattern_Error if Pattern = Null_String
+
+      declare
+         use BS20;
+         TC_Natural : Natural := 1000;
+      begin
+         TC_Natural := Index(To_Bounded_String("A Valid String"), 
+                             "",
+                             Ada.Strings.Forward,
+                             Map_To_Lower_Case_Ptr);
+         Report.Failed("Pattern_Error not raised by Function Index when " &
+                       "given a null pattern string");
+      exception
+         when Pattern_Error => null;   -- OK, expected exception.
+         when others        =>
+            Report.Failed("Incorrect exception raised by Function Index " &
+                          "using a Character_Mapping_Function parameter " &
+                          "when given a null pattern string");
+      end;
+
+
+      -- Function Count.
+
+      if BS20.Count(BS20.To_Bounded_String("ABABABA"), 
+                    Pattern => "aba",
+                    Mapping => Map_To_Lower_Case_Ptr)        /=  2   or
+         BS20.Count(BS20.To_Bounded_String("ABABABA"),
+                    "ABA", 
+                    Map_To_Lower_Case_Ptr)                   /=  0   or
+         BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
+                    "is",
+                    Map_To_Lower_Case_Ptr)                   /=  4   or
+         BS80.Count(BS80.To_Bounded_String("ABABABA"), 
+                    "ABA", 
+                    Map_To_Upper_Case_Ptr)                   /=  2   or
+         BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
+                    "is",
+                    Map_To_Upper_Case_Ptr)                   /=  0   or
+         BS80.Count(BS80.To_Bounded_String
+                           ("Peter Piper and his Pickled Peppers"),
+                    "p",
+                    Map_To_Lower_Case_Ptr)                   /=  7   or
+         BS20.Count(BS20.To_Bounded_String("She sells sea shells"),
+                    "s",
+                    Map_To_Upper_Case_Ptr)                   /=  0   or
+         BS80.Count(BS80.To_Bounded_String("No matches what-so-ever"),
+                    "matches",
+                    Map_To_Upper_Case_Ptr)                   /=  0
+      then
+         Report.Failed("Incorrect results from Function Count, using " &
+                       "a Character_Mapping_Function parameter");
+      end if;
+
+
+      -- Function Count, Pattern_Error if Pattern = Null_String
+
+      declare
+         use BS80;
+         TC_Natural : Natural := 1000;
+      begin
+         TC_Natural := Count(To_Bounded_String("A Valid String"), 
+                             "",
+                             Map_To_Lower_Case_Ptr);
+         Report.Failed("Pattern_Error not raised by Function Count using " &
+                       "a Character_Mapping_Function parameter when "      &
+                       "given a null pattern string");
+      exception
+         when Pattern_Error => null;   -- OK, expected exception.
+         when others        =>
+            Report.Failed("Incorrect exception raised by Function Count " &
+                          "using a Character_Mapping_Function parameter " &
+                          "when given a null pattern string");
+      end;
+
+
+      -- Function Translate.
+
+      if BS40.Translate(BS40.To_Bounded_String("A Mixed Case String"),
+                        Mapping => Map_To_Lower_Case_Ptr) /= 
+         BS40.To_Bounded_String("a mixed case string")      or
+
+         BS20."/="(BS20.Translate(BS20.To_Bounded_String("ALL LOWER CASE"),
+                                  Map_To_Lower_Case_Ptr),
+                   "all lower case")                        or
+
+         BS20."/="("end with lower case",
+                   BS20.Translate(
+                     BS20.To_Bounded_String("end with lower case"),
+                     Map_To_Lower_Case_Ptr))                or
+
+         BS1.Translate(BS1.Null_Bounded_String, 
+                       Map_To_Lower_Case_Ptr)             /=
+         BS1.Null_Bounded_String                            or
+
+         BS80."/="(BS80.Translate(BS80.To_Bounded_String
+                          ("start with lower case, end with upper case"),
+                        Map_To_Upper_Case_Ptr),
+                   "START WITH LOWER CASE, END WITH UPPER CASE") or
+
+         BS40.Translate(BS40.To_Bounded_String("ALL UPPER CASE STRING"),
+                        Map_To_Upper_Case_Ptr)            /=
+         BS40.To_Bounded_String("ALL UPPER CASE STRING")    or
+
+         BS80."/="(BS80.Translate(BS80.To_Bounded_String
+                          ("LoTs Of MiXeD CaSe ChArAcTeRs In ThE StRiNg"),
+                          Map_To_Upper_Case_Ptr),
+                   "LOTS OF MIXED CASE CHARACTERS IN THE STRING")
+
+      then
+         Report.Failed("Incorrect results from Function Translate, using " &
+                       "a Character_Mapping_Function parameter");
+      end if;
+
+
+      -- Procedure Translate.
+
+      BString_1 := BS1.To_Bounded_String("A");
+
+      BS1.Translate(Source => BString_1, Mapping => Map_To_Lower_Case_Ptr);
+
+      if not BS1."="(BString_1, "a") then    -- "=" for Bounded_String, String
+         Report.Failed("Incorrect result from Procedure Translate - 1");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String(String_20);
+      BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
+
+      if BString_20 /= BS20.To_Bounded_String("abcdefghijklmnopqrst") then
+         Report.Failed("Incorrect result from Procedure Translate - 2");
+      end if;
+
+      BString_40 := BS40.To_Bounded_String("String needing highlighting");
+      BS40.Translate(BString_40, Map_To_Upper_Case_Ptr);
+
+      if not (BString_40 = "STRING NEEDING HIGHLIGHTING") then
+         Report.Failed("Incorrect result from Procedure Translate - 3");
+      end if;
+
+      BString_80 := BS80.Null_Bounded_String;
+      BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
+
+      if not (BString_80 = BS80.Null_Bounded_String) then
+         Report.Failed("Incorrect result from Procedure Translate - 4");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4027;