aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.7/gcc/ada/a-stwiun.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.7/gcc/ada/a-stwiun.adb')
-rw-r--r--gcc-4.7/gcc/ada/a-stwiun.adb1098
1 files changed, 0 insertions, 1098 deletions
diff --git a/gcc-4.7/gcc/ada/a-stwiun.adb b/gcc-4.7/gcc/ada/a-stwiun.adb
deleted file mode 100644
index 77e427f92..000000000
--- a/gcc-4.7/gcc/ada/a-stwiun.adb
+++ /dev/null
@@ -1,1098 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- A D A . S T R I N G S . W I D E _ U N B O U N D E D --
--- --
--- B o d y --
--- --
--- Copyright (C) 1992-2010, 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. --
--- --
-------------------------------------------------------------------------------
-
-with Ada.Strings.Wide_Fixed;
-with Ada.Strings.Wide_Search;
-with Ada.Unchecked_Deallocation;
-
-package body Ada.Strings.Wide_Unbounded is
-
- use Ada.Finalization;
-
- ---------
- -- "&" --
- ---------
-
- function "&"
- (Left : Unbounded_Wide_String;
- Right : Unbounded_Wide_String) return Unbounded_Wide_String
- is
- L_Length : constant Natural := Left.Last;
- R_Length : constant Natural := Right.Last;
- Result : Unbounded_Wide_String;
-
- begin
- Result.Last := L_Length + R_Length;
-
- Result.Reference := new Wide_String (1 .. Result.Last);
-
- Result.Reference (1 .. L_Length) :=
- Left.Reference (1 .. Left.Last);
- Result.Reference (L_Length + 1 .. Result.Last) :=
- Right.Reference (1 .. Right.Last);
-
- return Result;
- end "&";
-
- function "&"
- (Left : Unbounded_Wide_String;
- Right : Wide_String) return Unbounded_Wide_String
- is
- L_Length : constant Natural := Left.Last;
- Result : Unbounded_Wide_String;
-
- begin
- Result.Last := L_Length + Right'Length;
-
- Result.Reference := new Wide_String (1 .. Result.Last);
-
- Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
- Result.Reference (L_Length + 1 .. Result.Last) := Right;
-
- return Result;
- end "&";
-
- function "&"
- (Left : Wide_String;
- Right : Unbounded_Wide_String) return Unbounded_Wide_String
- is
- R_Length : constant Natural := Right.Last;
- Result : Unbounded_Wide_String;
-
- begin
- Result.Last := Left'Length + R_Length;
-
- Result.Reference := new Wide_String (1 .. Result.Last);
-
- Result.Reference (1 .. Left'Length) := Left;
- Result.Reference (Left'Length + 1 .. Result.Last) :=
- Right.Reference (1 .. Right.Last);
-
- return Result;
- end "&";
-
- function "&"
- (Left : Unbounded_Wide_String;
- Right : Wide_Character) return Unbounded_Wide_String
- is
- Result : Unbounded_Wide_String;
-
- begin
- Result.Last := Left.Last + 1;
-
- Result.Reference := new Wide_String (1 .. Result.Last);
-
- Result.Reference (1 .. Result.Last - 1) :=
- Left.Reference (1 .. Left.Last);
- Result.Reference (Result.Last) := Right;
-
- return Result;
- end "&";
-
- function "&"
- (Left : Wide_Character;
- Right : Unbounded_Wide_String) return Unbounded_Wide_String
- is
- Result : Unbounded_Wide_String;
-
- begin
- Result.Last := Right.Last + 1;
-
- Result.Reference := new Wide_String (1 .. Result.Last);
- Result.Reference (1) := Left;
- Result.Reference (2 .. Result.Last) :=
- Right.Reference (1 .. Right.Last);
- return Result;
- end "&";
-
- ---------
- -- "*" --
- ---------
-
- function "*"
- (Left : Natural;
- Right : Wide_Character) return Unbounded_Wide_String
- is
- Result : Unbounded_Wide_String;
-
- begin
- Result.Last := Left;
-
- Result.Reference := new Wide_String (1 .. Left);
- for J in Result.Reference'Range loop
- Result.Reference (J) := Right;
- end loop;
-
- return Result;
- end "*";
-
- function "*"
- (Left : Natural;
- Right : Wide_String) return Unbounded_Wide_String
- is
- Len : constant Natural := Right'Length;
- K : Positive;
- Result : Unbounded_Wide_String;
-
- begin
- Result.Last := Left * Len;
-
- Result.Reference := new Wide_String (1 .. Result.Last);
-
- K := 1;
- for J in 1 .. Left loop
- Result.Reference (K .. K + Len - 1) := Right;
- K := K + Len;
- end loop;
-
- return Result;
- end "*";
-
- function "*"
- (Left : Natural;
- Right : Unbounded_Wide_String) return Unbounded_Wide_String
- is
- Len : constant Natural := Right.Last;
- K : Positive;
- Result : Unbounded_Wide_String;
-
- begin
- Result.Last := Left * Len;
-
- Result.Reference := new Wide_String (1 .. Result.Last);
-
- K := 1;
- for J in 1 .. Left loop
- Result.Reference (K .. K + Len - 1) :=
- Right.Reference (1 .. Right.Last);
- K := K + Len;
- end loop;
-
- return Result;
- end "*";
-
- ---------
- -- "<" --
- ---------
-
- function "<"
- (Left : Unbounded_Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return
- Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
- end "<";
-
- function "<"
- (Left : Unbounded_Wide_String;
- Right : Wide_String) return Boolean
- is
- begin
- return Left.Reference (1 .. Left.Last) < Right;
- end "<";
-
- function "<"
- (Left : Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return Left < Right.Reference (1 .. Right.Last);
- end "<";
-
- ----------
- -- "<=" --
- ----------
-
- function "<="
- (Left : Unbounded_Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return
- Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
- end "<=";
-
- function "<="
- (Left : Unbounded_Wide_String;
- Right : Wide_String) return Boolean
- is
- begin
- return Left.Reference (1 .. Left.Last) <= Right;
- end "<=";
-
- function "<="
- (Left : Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return Left <= Right.Reference (1 .. Right.Last);
- end "<=";
-
- ---------
- -- "=" --
- ---------
-
- function "="
- (Left : Unbounded_Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return
- Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
- end "=";
-
- function "="
- (Left : Unbounded_Wide_String;
- Right : Wide_String) return Boolean
- is
- begin
- return Left.Reference (1 .. Left.Last) = Right;
- end "=";
-
- function "="
- (Left : Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return Left = Right.Reference (1 .. Right.Last);
- end "=";
-
- ---------
- -- ">" --
- ---------
-
- function ">"
- (Left : Unbounded_Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return
- Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
- end ">";
-
- function ">"
- (Left : Unbounded_Wide_String;
- Right : Wide_String) return Boolean
- is
- begin
- return Left.Reference (1 .. Left.Last) > Right;
- end ">";
-
- function ">"
- (Left : Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return Left > Right.Reference (1 .. Right.Last);
- end ">";
-
- ----------
- -- ">=" --
- ----------
-
- function ">="
- (Left : Unbounded_Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return
- Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
- end ">=";
-
- function ">="
- (Left : Unbounded_Wide_String;
- Right : Wide_String) return Boolean
- is
- begin
- return Left.Reference (1 .. Left.Last) >= Right;
- end ">=";
-
- function ">="
- (Left : Wide_String;
- Right : Unbounded_Wide_String) return Boolean
- is
- begin
- return Left >= Right.Reference (1 .. Right.Last);
- end ">=";
-
- ------------
- -- Adjust --
- ------------
-
- procedure Adjust (Object : in out Unbounded_Wide_String) is
- begin
- -- Copy string, except we do not copy the statically allocated null
- -- string, since it can never be deallocated. Note that we do not copy
- -- extra string room here to avoid dragging unused allocated memory.
-
- if Object.Reference /= Null_Wide_String'Access then
- Object.Reference :=
- new Wide_String'(Object.Reference (1 .. Object.Last));
- end if;
- end Adjust;
-
- ------------
- -- Append --
- ------------
-
- procedure Append
- (Source : in out Unbounded_Wide_String;
- New_Item : Unbounded_Wide_String)
- is
- begin
- Realloc_For_Chunk (Source, New_Item.Last);
- Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
- New_Item.Reference (1 .. New_Item.Last);
- Source.Last := Source.Last + New_Item.Last;
- end Append;
-
- procedure Append
- (Source : in out Unbounded_Wide_String;
- New_Item : Wide_String)
- is
- begin
- Realloc_For_Chunk (Source, New_Item'Length);
- Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
- New_Item;
- Source.Last := Source.Last + New_Item'Length;
- end Append;
-
- procedure Append
- (Source : in out Unbounded_Wide_String;
- New_Item : Wide_Character)
- is
- begin
- Realloc_For_Chunk (Source, 1);
- Source.Reference (Source.Last + 1) := New_Item;
- Source.Last := Source.Last + 1;
- end Append;
-
- -----------
- -- Count --
- -----------
-
- function Count
- (Source : Unbounded_Wide_String;
- Pattern : Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
- return Natural
- is
- begin
- return
- Wide_Search.Count
- (Source.Reference (1 .. Source.Last), Pattern, Mapping);
- end Count;
-
- function Count
- (Source : Unbounded_Wide_String;
- Pattern : Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
- is
- begin
- return
- Wide_Search.Count
- (Source.Reference (1 .. Source.Last), Pattern, Mapping);
- end Count;
-
- function Count
- (Source : Unbounded_Wide_String;
- Set : Wide_Maps.Wide_Character_Set) return Natural
- is
- begin
- return
- Wide_Search.Count
- (Source.Reference (1 .. Source.Last), Set);
- end Count;
-
- ------------
- -- Delete --
- ------------
-
- function Delete
- (Source : Unbounded_Wide_String;
- From : Positive;
- Through : Natural) return Unbounded_Wide_String
- is
- begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Delete
- (Source.Reference (1 .. Source.Last), From, Through));
- end Delete;
-
- procedure Delete
- (Source : in out Unbounded_Wide_String;
- From : Positive;
- Through : Natural)
- is
- begin
- if From > Through then
- null;
-
- elsif From < Source.Reference'First or else Through > Source.Last then
- raise Index_Error;
-
- else
- declare
- Len : constant Natural := Through - From + 1;
-
- begin
- Source.Reference (From .. Source.Last - Len) :=
- Source.Reference (Through + 1 .. Source.Last);
- Source.Last := Source.Last - Len;
- end;
- end if;
- end Delete;
-
- -------------
- -- Element --
- -------------
-
- function Element
- (Source : Unbounded_Wide_String;
- Index : Positive) return Wide_Character
- is
- begin
- if Index <= Source.Last then
- return Source.Reference (Index);
- else
- raise Strings.Index_Error;
- end if;
- end Element;
-
- --------------
- -- Finalize --
- --------------
-
- procedure Finalize (Object : in out Unbounded_Wide_String) is
- procedure Deallocate is
- new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
-
- begin
- -- Note: Don't try to free statically allocated null string
-
- if Object.Reference /= Null_Wide_String'Access then
- Deallocate (Object.Reference);
- Object.Reference := Null_Unbounded_Wide_String.Reference;
- Object.Last := 0;
- end if;
- end Finalize;
-
- ----------------
- -- Find_Token --
- ----------------
-
- procedure Find_Token
- (Source : Unbounded_Wide_String;
- Set : Wide_Maps.Wide_Character_Set;
- From : Positive;
- Test : Strings.Membership;
- First : out Positive;
- Last : out Natural)
- is
- begin
- Wide_Search.Find_Token
- (Source.Reference (From .. Source.Last), Set, Test, First, Last);
- end Find_Token;
-
- procedure Find_Token
- (Source : Unbounded_Wide_String;
- Set : Wide_Maps.Wide_Character_Set;
- Test : Strings.Membership;
- First : out Positive;
- Last : out Natural)
- is
- begin
- Wide_Search.Find_Token
- (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
- end Find_Token;
-
- ----------
- -- Free --
- ----------
-
- procedure Free (X : in out Wide_String_Access) is
- procedure Deallocate is
- new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
-
- begin
- -- Note: Do not try to free statically allocated null string
-
- if X /= Null_Unbounded_Wide_String.Reference then
- Deallocate (X);
- end if;
- end Free;
-
- ----------
- -- Head --
- ----------
-
- function Head
- (Source : Unbounded_Wide_String;
- Count : Natural;
- Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
- is
- begin
- return To_Unbounded_Wide_String
- (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
- end Head;
-
- procedure Head
- (Source : in out Unbounded_Wide_String;
- Count : Natural;
- Pad : Wide_Character := Wide_Space)
- is
- Old : Wide_String_Access := Source.Reference;
- begin
- Source.Reference :=
- new Wide_String'
- (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
- Source.Last := Source.Reference'Length;
- Free (Old);
- end Head;
-
- -----------
- -- Index --
- -----------
-
- function Index
- (Source : Unbounded_Wide_String;
- Pattern : Wide_String;
- Going : Strings.Direction := Strings.Forward;
- Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
- return Natural
- is
- begin
- return
- Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
- end Index;
-
- function Index
- (Source : Unbounded_Wide_String;
- Pattern : Wide_String;
- Going : Direction := Forward;
- Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
- is
- begin
- return
- Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
- end Index;
-
- function Index
- (Source : Unbounded_Wide_String;
- Set : Wide_Maps.Wide_Character_Set;
- Test : Strings.Membership := Strings.Inside;
- Going : Strings.Direction := Strings.Forward) return Natural
- is
- begin
- return Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Set, Test, Going);
- end Index;
-
- function Index
- (Source : Unbounded_Wide_String;
- Pattern : Wide_String;
- From : Positive;
- Going : Direction := Forward;
- Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
- return Natural
- is
- begin
- return
- Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
- end Index;
-
- function Index
- (Source : Unbounded_Wide_String;
- Pattern : Wide_String;
- From : Positive;
- Going : Direction := Forward;
- Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
- is
- begin
- return
- Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
- end Index;
-
- function Index
- (Source : Unbounded_Wide_String;
- Set : Wide_Maps.Wide_Character_Set;
- From : Positive;
- Test : Membership := Inside;
- Going : Direction := Forward) return Natural
- is
- begin
- return
- Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
- end Index;
-
- function Index_Non_Blank
- (Source : Unbounded_Wide_String;
- Going : Strings.Direction := Strings.Forward) return Natural
- is
- begin
- return
- Wide_Search.Index_Non_Blank
- (Source.Reference (1 .. Source.Last), Going);
- end Index_Non_Blank;
-
- function Index_Non_Blank
- (Source : Unbounded_Wide_String;
- From : Positive;
- Going : Direction := Forward) return Natural
- is
- begin
- return
- Wide_Search.Index_Non_Blank
- (Source.Reference (1 .. Source.Last), From, Going);
- end Index_Non_Blank;
-
- ----------------
- -- Initialize --
- ----------------
-
- procedure Initialize (Object : in out Unbounded_Wide_String) is
- begin
- Object.Reference := Null_Unbounded_Wide_String.Reference;
- Object.Last := 0;
- end Initialize;
-
- ------------
- -- Insert --
- ------------
-
- function Insert
- (Source : Unbounded_Wide_String;
- Before : Positive;
- New_Item : Wide_String) return Unbounded_Wide_String
- is
- begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Insert
- (Source.Reference (1 .. Source.Last), Before, New_Item));
- end Insert;
-
- procedure Insert
- (Source : in out Unbounded_Wide_String;
- Before : Positive;
- New_Item : Wide_String)
- is
- begin
- if Before not in Source.Reference'First .. Source.Last + 1 then
- raise Index_Error;
- end if;
-
- Realloc_For_Chunk (Source, New_Item'Length);
-
- Source.Reference
- (Before + New_Item'Length .. Source.Last + New_Item'Length) :=
- Source.Reference (Before .. Source.Last);
-
- Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
- Source.Last := Source.Last + New_Item'Length;
- end Insert;
-
- ------------
- -- Length --
- ------------
-
- function Length (Source : Unbounded_Wide_String) return Natural is
- begin
- return Source.Last;
- end Length;
-
- ---------------
- -- Overwrite --
- ---------------
-
- function Overwrite
- (Source : Unbounded_Wide_String;
- Position : Positive;
- New_Item : Wide_String) return Unbounded_Wide_String
- is
- begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Overwrite
- (Source.Reference (1 .. Source.Last), Position, New_Item));
- end Overwrite;
-
- procedure Overwrite
- (Source : in out Unbounded_Wide_String;
- Position : Positive;
- New_Item : Wide_String)
- is
- NL : constant Natural := New_Item'Length;
- begin
- if Position <= Source.Last - NL + 1 then
- Source.Reference (Position .. Position + NL - 1) := New_Item;
- else
- declare
- Old : Wide_String_Access := Source.Reference;
- begin
- Source.Reference := new Wide_String'
- (Wide_Fixed.Overwrite
- (Source.Reference (1 .. Source.Last), Position, New_Item));
- Source.Last := Source.Reference'Length;
- Free (Old);
- end;
- end if;
- end Overwrite;
-
- -----------------------
- -- Realloc_For_Chunk --
- -----------------------
-
- procedure Realloc_For_Chunk
- (Source : in out Unbounded_Wide_String;
- Chunk_Size : Natural)
- is
- Growth_Factor : constant := 32;
- -- The growth factor controls how much extra space is allocated when
- -- we have to increase the size of an allocated unbounded string. By
- -- allocating extra space, we avoid the need to reallocate on every
- -- append, particularly important when a string is built up by repeated
- -- append operations of small pieces. This is expressed as a factor so
- -- 32 means add 1/32 of the length of the string as growth space.
-
- Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
- -- Allocation will be done by a multiple of Min_Mul_Alloc This causes
- -- no memory loss as most (all?) malloc implementations are obliged to
- -- align the returned memory on the maximum alignment as malloc does not
- -- know the target alignment.
-
- S_Length : constant Natural := Source.Reference'Length;
-
- begin
- if Chunk_Size > S_Length - Source.Last then
- declare
- New_Size : constant Positive :=
- S_Length + Chunk_Size + (S_Length / Growth_Factor);
-
- New_Rounded_Up_Size : constant Positive :=
- ((New_Size - 1) / Min_Mul_Alloc + 1) *
- Min_Mul_Alloc;
-
- Tmp : constant Wide_String_Access :=
- new Wide_String (1 .. New_Rounded_Up_Size);
-
- begin
- Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
- Free (Source.Reference);
- Source.Reference := Tmp;
- end;
- end if;
- end Realloc_For_Chunk;
-
- ---------------------
- -- Replace_Element --
- ---------------------
-
- procedure Replace_Element
- (Source : in out Unbounded_Wide_String;
- Index : Positive;
- By : Wide_Character)
- is
- begin
- if Index <= Source.Last then
- Source.Reference (Index) := By;
- else
- raise Strings.Index_Error;
- end if;
- end Replace_Element;
-
- -------------------
- -- Replace_Slice --
- -------------------
-
- function Replace_Slice
- (Source : Unbounded_Wide_String;
- Low : Positive;
- High : Natural;
- By : Wide_String) return Unbounded_Wide_String
- is
- begin
- return To_Unbounded_Wide_String
- (Wide_Fixed.Replace_Slice
- (Source.Reference (1 .. Source.Last), Low, High, By));
- end Replace_Slice;
-
- procedure Replace_Slice
- (Source : in out Unbounded_Wide_String;
- Low : Positive;
- High : Natural;
- By : Wide_String)
- is
- Old : Wide_String_Access := Source.Reference;
- begin
- Source.Reference := new Wide_String'
- (Wide_Fixed.Replace_Slice
- (Source.Reference (1 .. Source.Last), Low, High, By));
- Source.Last := Source.Reference'Length;
- Free (Old);
- end Replace_Slice;
-
- -------------------------------
- -- Set_Unbounded_Wide_String --
- -------------------------------
-
- procedure Set_Unbounded_Wide_String
- (Target : out Unbounded_Wide_String;
- Source : Wide_String)
- is
- begin
- Target.Last := Source'Length;
- Target.Reference := new Wide_String (1 .. Source'Length);
- Target.Reference.all := Source;
- end Set_Unbounded_Wide_String;
-
- -----------
- -- Slice --
- -----------
-
- function Slice
- (Source : Unbounded_Wide_String;
- Low : Positive;
- High : Natural) return Wide_String
- is
- begin
- -- Note: test of High > Length is in accordance with AI95-00128
-
- if Low > Source.Last + 1 or else High > Source.Last then
- raise Index_Error;
- else
- return Source.Reference (Low .. High);
- end if;
- end Slice;
-
- ----------
- -- Tail --
- ----------
-
- function Tail
- (Source : Unbounded_Wide_String;
- Count : Natural;
- Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is
- begin
- return To_Unbounded_Wide_String
- (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
- end Tail;
-
- procedure Tail
- (Source : in out Unbounded_Wide_String;
- Count : Natural;
- Pad : Wide_Character := Wide_Space)
- is
- Old : Wide_String_Access := Source.Reference;
- begin
- Source.Reference := new Wide_String'
- (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
- Source.Last := Source.Reference'Length;
- Free (Old);
- end Tail;
-
- ------------------------------
- -- To_Unbounded_Wide_String --
- ------------------------------
-
- function To_Unbounded_Wide_String
- (Source : Wide_String)
- return Unbounded_Wide_String
- is
- Result : Unbounded_Wide_String;
- begin
- Result.Last := Source'Length;
- Result.Reference := new Wide_String (1 .. Source'Length);
- Result.Reference.all := Source;
- return Result;
- end To_Unbounded_Wide_String;
-
- function To_Unbounded_Wide_String
- (Length : Natural) return Unbounded_Wide_String
- is
- Result : Unbounded_Wide_String;
- begin
- Result.Last := Length;
- Result.Reference := new Wide_String (1 .. Length);
- return Result;
- end To_Unbounded_Wide_String;
-
- -------------------
- -- To_Wide_String --
- --------------------
-
- function To_Wide_String
- (Source : Unbounded_Wide_String)
- return Wide_String
- is
- begin
- return Source.Reference (1 .. Source.Last);
- end To_Wide_String;
-
- ---------------
- -- Translate --
- ---------------
-
- function Translate
- (Source : Unbounded_Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping)
- return Unbounded_Wide_String
- is
- begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Translate
- (Source.Reference (1 .. Source.Last), Mapping));
- end Translate;
-
- procedure Translate
- (Source : in out Unbounded_Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping)
- is
- begin
- Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
- end Translate;
-
- function Translate
- (Source : Unbounded_Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping_Function)
- return Unbounded_Wide_String
- is
- begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Translate
- (Source.Reference (1 .. Source.Last), Mapping));
- end Translate;
-
- procedure Translate
- (Source : in out Unbounded_Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping_Function)
- is
- begin
- Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
- end Translate;
-
- ----------
- -- Trim --
- ----------
-
- function Trim
- (Source : Unbounded_Wide_String;
- Side : Trim_End) return Unbounded_Wide_String
- is
- begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
- end Trim;
-
- procedure Trim
- (Source : in out Unbounded_Wide_String;
- Side : Trim_End)
- is
- Old : Wide_String_Access := Source.Reference;
- begin
- Source.Reference :=
- new Wide_String'
- (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
- Source.Last := Source.Reference'Length;
- Free (Old);
- end Trim;
-
- function Trim
- (Source : Unbounded_Wide_String;
- Left : Wide_Maps.Wide_Character_Set;
- Right : Wide_Maps.Wide_Character_Set)
- return Unbounded_Wide_String
- is
- begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Trim
- (Source.Reference (1 .. Source.Last), Left, Right));
- end Trim;
-
- procedure Trim
- (Source : in out Unbounded_Wide_String;
- Left : Wide_Maps.Wide_Character_Set;
- Right : Wide_Maps.Wide_Character_Set)
- is
- Old : Wide_String_Access := Source.Reference;
- begin
- Source.Reference :=
- new Wide_String'
- (Wide_Fixed.Trim
- (Source.Reference (1 .. Source.Last), Left, Right));
- Source.Last := Source.Reference'Length;
- Free (Old);
- end Trim;
-
- ---------------------
- -- Unbounded_Slice --
- ---------------------
-
- function Unbounded_Slice
- (Source : Unbounded_Wide_String;
- Low : Positive;
- High : Natural) return Unbounded_Wide_String
- is
- begin
- if Low > Source.Last + 1 or else High > Source.Last then
- raise Index_Error;
- else
- return To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
- end if;
- end Unbounded_Slice;
-
- procedure Unbounded_Slice
- (Source : Unbounded_Wide_String;
- Target : out Unbounded_Wide_String;
- Low : Positive;
- High : Natural)
- is
- begin
- if Low > Source.Last + 1 or else High > Source.Last then
- raise Index_Error;
- else
- Target :=
- To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
- end if;
- end Unbounded_Slice;
-
-end Ada.Strings.Wide_Unbounded;