diff options
Diffstat (limited to 'gcc-4.4.0/gcc/ada/a-strfix.adb')
| -rw-r--r-- | gcc-4.4.0/gcc/ada/a-strfix.adb | 729 |
1 files changed, 0 insertions, 729 deletions
diff --git a/gcc-4.4.0/gcc/ada/a-strfix.adb b/gcc-4.4.0/gcc/ada/a-strfix.adb deleted file mode 100644 index 3dad72bcf..000000000 --- a/gcc-4.4.0/gcc/ada/a-strfix.adb +++ /dev/null @@ -1,729 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- A D A . S T R I N G S . F I X E D -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Note: This code is derived from the ADAR.CSH public domain Ada 83 versions --- of the Appendix C string handling packages. One change is to avoid the use --- of Is_In, so that we are not dependent on inlining. Note that the search --- function implementations are to be found in the auxiliary package --- Ada.Strings.Search. Also the Move procedure is directly incorporated (ADAR --- used a subunit for this procedure). The number of errors having to do with --- bounds of function return results were also fixed, and use of & removed for --- efficiency reasons. - -with Ada.Strings.Maps; use Ada.Strings.Maps; -with Ada.Strings.Search; - -package body Ada.Strings.Fixed is - - ------------------------ - -- Search Subprograms -- - ------------------------ - - function Index - (Source : String; - Pattern : String; - Going : Direction := Forward; - Mapping : Maps.Character_Mapping := Maps.Identity) return Natural - renames Ada.Strings.Search.Index; - - function Index - (Source : String; - Pattern : String; - Going : Direction := Forward; - Mapping : Maps.Character_Mapping_Function) return Natural - renames Ada.Strings.Search.Index; - - function Index - (Source : String; - Set : Maps.Character_Set; - Test : Membership := Inside; - Going : Direction := Forward) return Natural - renames Ada.Strings.Search.Index; - - function Index - (Source : String; - Pattern : String; - From : Positive; - Going : Direction := Forward; - Mapping : Maps.Character_Mapping := Maps.Identity) return Natural - renames Ada.Strings.Search.Index; - - function Index - (Source : String; - Pattern : String; - From : Positive; - Going : Direction := Forward; - Mapping : Maps.Character_Mapping_Function) return Natural - renames Ada.Strings.Search.Index; - - function Index - (Source : String; - Set : Maps.Character_Set; - From : Positive; - Test : Membership := Inside; - Going : Direction := Forward) return Natural - renames Ada.Strings.Search.Index; - - function Index_Non_Blank - (Source : String; - Going : Direction := Forward) return Natural - renames Ada.Strings.Search.Index_Non_Blank; - - function Index_Non_Blank - (Source : String; - From : Positive; - Going : Direction := Forward) return Natural - renames Ada.Strings.Search.Index_Non_Blank; - - function Count - (Source : String; - Pattern : String; - Mapping : Maps.Character_Mapping := Maps.Identity) return Natural - renames Ada.Strings.Search.Count; - - function Count - (Source : String; - Pattern : String; - Mapping : Maps.Character_Mapping_Function) return Natural - renames Ada.Strings.Search.Count; - - function Count - (Source : String; - Set : Maps.Character_Set) return Natural - renames Ada.Strings.Search.Count; - - procedure Find_Token - (Source : String; - Set : Maps.Character_Set; - Test : Membership; - First : out Positive; - Last : out Natural) - renames Ada.Strings.Search.Find_Token; - - --------- - -- "*" -- - --------- - - function "*" - (Left : Natural; - Right : Character) return String - is - Result : String (1 .. Left); - - begin - for J in Result'Range loop - Result (J) := Right; - end loop; - - return Result; - end "*"; - - function "*" - (Left : Natural; - Right : String) return String - is - Result : String (1 .. Left * Right'Length); - Ptr : Integer := 1; - - begin - for J in 1 .. Left loop - Result (Ptr .. Ptr + Right'Length - 1) := Right; - Ptr := Ptr + Right'Length; - end loop; - - return Result; - end "*"; - - ------------ - -- Delete -- - ------------ - - function Delete - (Source : String; - From : Positive; - Through : Natural) return String - is - begin - if From > Through then - declare - subtype Result_Type is String (1 .. Source'Length); - - begin - return Result_Type (Source); - end; - - elsif From not in Source'Range - or else Through > Source'Last - then - raise Index_Error; - - else - declare - Front : constant Integer := From - Source'First; - Result : String (1 .. Source'Length - (Through - From + 1)); - - begin - Result (1 .. Front) := - Source (Source'First .. From - 1); - Result (Front + 1 .. Result'Last) := - Source (Through + 1 .. Source'Last); - - return Result; - end; - end if; - end Delete; - - procedure Delete - (Source : in out String; - From : Positive; - Through : Natural; - Justify : Alignment := Left; - Pad : Character := Space) - is - begin - Move (Source => Delete (Source, From, Through), - Target => Source, - Justify => Justify, - Pad => Pad); - end Delete; - - ---------- - -- Head -- - ---------- - - function Head - (Source : String; - Count : Natural; - Pad : Character := Space) return String - is - subtype Result_Type is String (1 .. Count); - - begin - if Count < Source'Length then - return - Result_Type (Source (Source'First .. Source'First + Count - 1)); - - else - declare - Result : Result_Type; - - begin - Result (1 .. Source'Length) := Source; - - for J in Source'Length + 1 .. Count loop - Result (J) := Pad; - end loop; - - return Result; - end; - end if; - end Head; - - procedure Head - (Source : in out String; - Count : Natural; - Justify : Alignment := Left; - Pad : Character := Space) - is - begin - Move (Source => Head (Source, Count, Pad), - Target => Source, - Drop => Error, - Justify => Justify, - Pad => Pad); - end Head; - - ------------ - -- Insert -- - ------------ - - function Insert - (Source : String; - Before : Positive; - New_Item : String) return String - is - Result : String (1 .. Source'Length + New_Item'Length); - Front : constant Integer := Before - Source'First; - - begin - if Before not in Source'First .. Source'Last + 1 then - raise Index_Error; - end if; - - Result (1 .. Front) := - Source (Source'First .. Before - 1); - Result (Front + 1 .. Front + New_Item'Length) := - New_Item; - Result (Front + New_Item'Length + 1 .. Result'Last) := - Source (Before .. Source'Last); - - return Result; - end Insert; - - procedure Insert - (Source : in out String; - Before : Positive; - New_Item : String; - Drop : Truncation := Error) - is - begin - Move (Source => Insert (Source, Before, New_Item), - Target => Source, - Drop => Drop); - end Insert; - - ---------- - -- Move -- - ---------- - - procedure Move - (Source : String; - Target : out String; - Drop : Truncation := Error; - Justify : Alignment := Left; - Pad : Character := Space) - is - Sfirst : constant Integer := Source'First; - Slast : constant Integer := Source'Last; - Slength : constant Integer := Source'Length; - - Tfirst : constant Integer := Target'First; - Tlast : constant Integer := Target'Last; - Tlength : constant Integer := Target'Length; - - function Is_Padding (Item : String) return Boolean; - -- Check if Item is all Pad characters, return True if so, False if not - - function Is_Padding (Item : String) return Boolean is - begin - for J in Item'Range loop - if Item (J) /= Pad then - return False; - end if; - end loop; - - return True; - end Is_Padding; - - -- Start of processing for Move - - begin - if Slength = Tlength then - Target := Source; - - elsif Slength > Tlength then - - case Drop is - when Left => - Target := Source (Slast - Tlength + 1 .. Slast); - - when Right => - Target := Source (Sfirst .. Sfirst + Tlength - 1); - - when Error => - case Justify is - when Left => - if Is_Padding (Source (Sfirst + Tlength .. Slast)) then - Target := - Source (Sfirst .. Sfirst + Target'Length - 1); - else - raise Length_Error; - end if; - - when Right => - if Is_Padding (Source (Sfirst .. Slast - Tlength)) then - Target := Source (Slast - Tlength + 1 .. Slast); - else - raise Length_Error; - end if; - - when Center => - raise Length_Error; - end case; - - end case; - - -- Source'Length < Target'Length - - else - case Justify is - when Left => - Target (Tfirst .. Tfirst + Slength - 1) := Source; - - for I in Tfirst + Slength .. Tlast loop - Target (I) := Pad; - end loop; - - when Right => - for I in Tfirst .. Tlast - Slength loop - Target (I) := Pad; - end loop; - - Target (Tlast - Slength + 1 .. Tlast) := Source; - - when Center => - declare - Front_Pad : constant Integer := (Tlength - Slength) / 2; - Tfirst_Fpad : constant Integer := Tfirst + Front_Pad; - - begin - for I in Tfirst .. Tfirst_Fpad - 1 loop - Target (I) := Pad; - end loop; - - Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source; - - for I in Tfirst_Fpad + Slength .. Tlast loop - Target (I) := Pad; - end loop; - end; - end case; - end if; - end Move; - - --------------- - -- Overwrite -- - --------------- - - function Overwrite - (Source : String; - Position : Positive; - New_Item : String) return String - is - begin - if Position not in Source'First .. Source'Last + 1 then - raise Index_Error; - end if; - - declare - Result_Length : constant Natural := - Integer'Max - (Source'Length, - Position - Source'First + New_Item'Length); - - Result : String (1 .. Result_Length); - Front : constant Integer := Position - Source'First; - - begin - Result (1 .. Front) := - Source (Source'First .. Position - 1); - Result (Front + 1 .. Front + New_Item'Length) := - New_Item; - Result (Front + New_Item'Length + 1 .. Result'Length) := - Source (Position + New_Item'Length .. Source'Last); - return Result; - end; - end Overwrite; - - procedure Overwrite - (Source : in out String; - Position : Positive; - New_Item : String; - Drop : Truncation := Right) - is - begin - Move (Source => Overwrite (Source, Position, New_Item), - Target => Source, - Drop => Drop); - end Overwrite; - - ------------------- - -- Replace_Slice -- - ------------------- - - function Replace_Slice - (Source : String; - Low : Positive; - High : Natural; - By : String) return String - is - begin - if Low > Source'Last + 1 or High < Source'First - 1 then - raise Index_Error; - end if; - - if High >= Low then - declare - Front_Len : constant Integer := - Integer'Max (0, Low - Source'First); - -- Length of prefix of Source copied to result - - Back_Len : constant Integer := - Integer'Max (0, Source'Last - High); - -- Length of suffix of Source copied to result - - Result_Length : constant Integer := - Front_Len + By'Length + Back_Len; - -- Length of result - - Result : String (1 .. Result_Length); - - begin - Result (1 .. Front_Len) := - Source (Source'First .. Low - 1); - Result (Front_Len + 1 .. Front_Len + By'Length) := - By; - Result (Front_Len + By'Length + 1 .. Result'Length) := - Source (High + 1 .. Source'Last); - - return Result; - end; - - else - return Insert (Source, Before => Low, New_Item => By); - end if; - end Replace_Slice; - - procedure Replace_Slice - (Source : in out String; - Low : Positive; - High : Natural; - By : String; - Drop : Truncation := Error; - Justify : Alignment := Left; - Pad : Character := Space) - is - begin - Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad); - end Replace_Slice; - - ---------- - -- Tail -- - ---------- - - function Tail - (Source : String; - Count : Natural; - Pad : Character := Space) return String - is - subtype Result_Type is String (1 .. Count); - - begin - if Count < Source'Length then - return Result_Type (Source (Source'Last - Count + 1 .. Source'Last)); - - -- Pad on left - - else - declare - Result : Result_Type; - - begin - for J in 1 .. Count - Source'Length loop - Result (J) := Pad; - end loop; - - Result (Count - Source'Length + 1 .. Count) := Source; - return Result; - end; - end if; - end Tail; - - procedure Tail - (Source : in out String; - Count : Natural; - Justify : Alignment := Left; - Pad : Character := Space) - is - begin - Move (Source => Tail (Source, Count, Pad), - Target => Source, - Drop => Error, - Justify => Justify, - Pad => Pad); - end Tail; - - --------------- - -- Translate -- - --------------- - - function Translate - (Source : String; - Mapping : Maps.Character_Mapping) return String - is - Result : String (1 .. Source'Length); - - begin - for J in Source'Range loop - Result (J - (Source'First - 1)) := Value (Mapping, Source (J)); - end loop; - - return Result; - end Translate; - - procedure Translate - (Source : in out String; - Mapping : Maps.Character_Mapping) - is - begin - for J in Source'Range loop - Source (J) := Value (Mapping, Source (J)); - end loop; - end Translate; - - function Translate - (Source : String; - Mapping : Maps.Character_Mapping_Function) return String - is - Result : String (1 .. Source'Length); - pragma Unsuppress (Access_Check); - - begin - for J in Source'Range loop - Result (J - (Source'First - 1)) := Mapping.all (Source (J)); - end loop; - - return Result; - end Translate; - - procedure Translate - (Source : in out String; - Mapping : Maps.Character_Mapping_Function) - is - pragma Unsuppress (Access_Check); - begin - for J in Source'Range loop - Source (J) := Mapping.all (Source (J)); - end loop; - end Translate; - - ---------- - -- Trim -- - ---------- - - function Trim - (Source : String; - Side : Trim_End) return String - is - Low, High : Integer; - - begin - Low := Index_Non_Blank (Source, Forward); - - -- All blanks case - - if Low = 0 then - return ""; - - -- At least one non-blank - - else - High := Index_Non_Blank (Source, Backward); - - case Side is - when Strings.Left => - declare - subtype Result_Type is String (1 .. Source'Last - Low + 1); - - begin - return Result_Type (Source (Low .. Source'Last)); - end; - - when Strings.Right => - declare - subtype Result_Type is String (1 .. High - Source'First + 1); - - begin - return Result_Type (Source (Source'First .. High)); - end; - - when Strings.Both => - declare - subtype Result_Type is String (1 .. High - Low + 1); - - begin - return Result_Type (Source (Low .. High)); - end; - end case; - end if; - end Trim; - - procedure Trim - (Source : in out String; - Side : Trim_End; - Justify : Alignment := Left; - Pad : Character := Space) - is - begin - Move (Trim (Source, Side), - Source, - Justify => Justify, - Pad => Pad); - end Trim; - - function Trim - (Source : String; - Left : Maps.Character_Set; - Right : Maps.Character_Set) return String - is - High, Low : Integer; - - begin - Low := Index (Source, Set => Left, Test => Outside, Going => Forward); - - -- Case where source comprises only characters in Left - - if Low = 0 then - return ""; - end if; - - High := - Index (Source, Set => Right, Test => Outside, Going => Backward); - - -- Case where source comprises only characters in Right - - if High = 0 then - return ""; - end if; - - declare - subtype Result_Type is String (1 .. High - Low + 1); - - begin - return Result_Type (Source (Low .. High)); - end; - end Trim; - - procedure Trim - (Source : in out String; - Left : Maps.Character_Set; - Right : Maps.Character_Set; - Justify : Alignment := Strings.Left; - Pad : Character := Space) - is - begin - Move (Source => Trim (Source, Left, Right), - Target => Source, - Justify => Justify, - Pad => Pad); - end Trim; - -end Ada.Strings.Fixed; |