------------------------------------------------------------------------------
-- --
--- GNAT RUNTIME COMPONENTS --
+-- 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 --
-- --
--- $Revision: 1.14 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- 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 2, or (at your option) any later ver- --
+-- 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. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- 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. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- 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. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
function "&"
(Left : Unbounded_Wide_String;
- Right : Unbounded_Wide_String)
- return Unbounded_Wide_String
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String
is
- L_Length : constant Integer := Left.Reference.all'Length;
- R_Length : constant Integer := Right.Reference.all'Length;
- Length : constant Integer := L_Length + R_Length;
+ L_Length : constant Natural := Left.Last;
+ R_Length : constant Natural := Right.Last;
Result : Unbounded_Wide_String;
begin
- Result.Reference := new Wide_String (1 .. Length);
- Result.Reference.all (1 .. L_Length) := Left.Reference.all;
- Result.Reference.all (L_Length + 1 .. Length) := Right.Reference.all;
+ 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
+ Right : Wide_String) return Unbounded_Wide_String
is
- L_Length : constant Integer := Left.Reference.all'Length;
- Length : constant Integer := L_Length + Right'Length;
+ L_Length : constant Natural := Left.Last;
Result : Unbounded_Wide_String;
begin
- Result.Reference := new Wide_String (1 .. Length);
- Result.Reference.all (1 .. L_Length) := Left.Reference.all;
- Result.Reference.all (L_Length + 1 .. Length) := Right;
+ 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
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String
is
- R_Length : constant Integer := Right.Reference.all'Length;
- Length : constant Integer := Left'Length + R_Length;
+ R_Length : constant Natural := Right.Last;
Result : Unbounded_Wide_String;
begin
- Result.Reference := new Wide_String (1 .. Length);
- Result.Reference.all (1 .. Left'Length) := Left;
- Result.Reference.all (Left'Length + 1 .. Length) := Right.Reference.all;
+ 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
+ Right : Wide_Character) return Unbounded_Wide_String
is
- Length : constant Integer := Left.Reference.all'Length + 1;
Result : Unbounded_Wide_String;
begin
- Result.Reference := new Wide_String (1 .. Length);
- Result.Reference.all (1 .. Length - 1) := Left.Reference.all;
- Result.Reference.all (Length) := Right;
+ 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
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String
is
- Length : constant Integer := Right.Reference.all'Length + 1;
Result : Unbounded_Wide_String;
begin
- Result.Reference := new Wide_String (1 .. Length);
- Result.Reference.all (1) := Left;
- Result.Reference.all (2 .. Length) := Right.Reference.all;
+ 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
+ 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 "*";
function "*"
- (Left : Natural;
- Right : Wide_String)
- return Unbounded_Wide_String
+ (Left : Natural;
+ Right : Wide_String) return Unbounded_Wide_String
is
+ Len : constant Natural := Right'Length;
+ K : Positive;
Result : Unbounded_Wide_String;
begin
- Result.Reference := new Wide_String (1 .. Left * Right'Length);
+ Result.Last := Left * Len;
+ Result.Reference := new Wide_String (1 .. Result.Last);
+
+ K := 1;
for J in 1 .. Left loop
- Result.Reference.all
- (Right'Length * J - Right'Length + 1 .. Right'Length * J) := Right;
+ Result.Reference (K .. K + Len - 1) := Right;
+ K := K + Len;
end loop;
return Result;
function "*"
(Left : Natural;
- Right : Unbounded_Wide_String)
- return Unbounded_Wide_String
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String
is
- R_Length : constant Integer := Right.Reference.all'Length;
- Result : Unbounded_Wide_String;
+ Len : constant Natural := Right.Last;
+ K : Positive;
+ Result : Unbounded_Wide_String;
begin
- Result.Reference := new Wide_String (1 .. Left * R_Length);
+ Result.Last := Left * Len;
+
+ Result.Reference := new Wide_String (1 .. Result.Last);
- for I in 1 .. Left loop
- Result.Reference.all (R_Length * I - R_Length + 1 .. R_Length * I) :=
- Right.Reference.all;
+ 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;
---------
function "<"
- (Left : in Unbounded_Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left.Reference.all < Right.Reference.all;
+ return
+ Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
end "<";
function "<"
- (Left : in Unbounded_Wide_String;
- Right : in Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
is
begin
- return Left.Reference.all < Right;
+ return Left.Reference (1 .. Left.Last) < Right;
end "<";
function "<"
- (Left : in Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left < Right.Reference.all;
+ return Left < Right.Reference (1 .. Right.Last);
end "<";
----------
----------
function "<="
- (Left : in Unbounded_Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left.Reference.all <= Right.Reference.all;
+ return
+ Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
end "<=";
function "<="
- (Left : in Unbounded_Wide_String;
- Right : in Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
is
begin
- return Left.Reference.all <= Right;
+ return Left.Reference (1 .. Left.Last) <= Right;
end "<=";
function "<="
- (Left : in Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left <= Right.Reference.all;
+ return Left <= Right.Reference (1 .. Right.Last);
end "<=";
---------
---------
function "="
- (Left : in Unbounded_Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left.Reference.all = Right.Reference.all;
+ return
+ Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
end "=";
function "="
- (Left : in Unbounded_Wide_String;
- Right : in Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
is
begin
- return Left.Reference.all = Right;
+ return Left.Reference (1 .. Left.Last) = Right;
end "=";
function "="
- (Left : in Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left = Right.Reference.all;
+ return Left = Right.Reference (1 .. Right.Last);
end "=";
---------
---------
function ">"
- (Left : in Unbounded_Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left.Reference.all > Right.Reference.all;
+ return
+ Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
end ">";
function ">"
- (Left : in Unbounded_Wide_String;
- Right : in Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
is
begin
- return Left.Reference.all > Right;
+ return Left.Reference (1 .. Left.Last) > Right;
end ">";
function ">"
- (Left : in Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left > Right.Reference.all;
+ return Left > Right.Reference (1 .. Right.Last);
end ">";
----------
----------
function ">="
- (Left : in Unbounded_Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left.Reference.all >= Right.Reference.all;
+ return
+ Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
end ">=";
function ">="
- (Left : in Unbounded_Wide_String;
- Right : in Wide_String)
- return Boolean
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
is
begin
- return Left.Reference.all >= Right;
+ return Left.Reference (1 .. Left.Last) >= Right;
end ">=";
function ">="
- (Left : in Wide_String;
- Right : in Unbounded_Wide_String)
- return Boolean
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
is
begin
- return Left >= Right.Reference.all;
+ return Left >= Right.Reference (1 .. Right.Last);
end ">=";
------------
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.
+ -- 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.all);
+ Object.Reference :=
+ new Wide_String'(Object.Reference (1 .. Object.Last));
end if;
end Adjust;
procedure Append
(Source : in out Unbounded_Wide_String;
- New_Item : in Unbounded_Wide_String)
+ New_Item : Unbounded_Wide_String)
is
- S_Length : constant Integer := Source.Reference.all'Length;
- Length : constant Integer := S_Length + New_Item.Reference.all'Length;
- Temp : Wide_String_Access := Source.Reference;
-
begin
- if Source.Reference = Null_Wide_String'Access then
- Source := To_Unbounded_Wide_String (New_Item.Reference.all);
- return;
- end if;
-
- Source.Reference := new Wide_String (1 .. Length);
-
- Source.Reference.all (1 .. S_Length) := Temp.all;
- Source.Reference.all (S_Length + 1 .. Length) := New_Item.Reference.all;
- Free (Temp);
+ 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 : in Wide_String)
+ New_Item : Wide_String)
is
- S_Length : constant Integer := Source.Reference.all'Length;
- Length : constant Integer := S_Length + New_Item'Length;
- Temp : Wide_String_Access := Source.Reference;
-
begin
- if Source.Reference = Null_Wide_String'Access then
- Source := To_Unbounded_Wide_String (New_Item);
- return;
- end if;
-
- Source.Reference := new Wide_String (1 .. Length);
- Source.Reference.all (1 .. S_Length) := Temp.all;
- Source.Reference.all (S_Length + 1 .. Length) := New_Item;
- Free (Temp);
+ 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 : in Wide_Character)
+ New_Item : Wide_Character)
is
- S_Length : constant Integer := Source.Reference.all'Length;
- Length : constant Integer := S_Length + 1;
- Temp : Wide_String_Access := Source.Reference;
-
begin
- if Source.Reference = Null_Wide_String'Access then
- Source := To_Unbounded_Wide_String ("" & New_Item);
- return;
- end if;
-
- Source.Reference := new Wide_String (1 .. Length);
- Source.Reference.all (1 .. S_Length) := Temp.all;
- Source.Reference.all (S_Length + 1) := New_Item;
- Free (Temp);
+ Realloc_For_Chunk (Source, 1);
+ Source.Reference (Source.Last + 1) := New_Item;
+ Source.Last := Source.Last + 1;
end Append;
-----------
-----------
function Count
- (Source : Unbounded_Wide_String;
- Pattern : Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping :=
- Wide_Maps.Identity)
- return Natural
+ (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.all, Pattern, Mapping);
+ return
+ Wide_Search.Count
+ (Source.Reference (1 .. Source.Last), Pattern, Mapping);
end Count;
function Count
- (Source : in Unbounded_Wide_String;
- Pattern : in Wide_String;
- Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
- return Natural
+ (Source : Unbounded_Wide_String;
+ Pattern : Wide_String;
+ Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
is
begin
- return Wide_Search.Count (Source.Reference.all, Pattern, Mapping);
+ 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
+ (Source : Unbounded_Wide_String;
+ Set : Wide_Maps.Wide_Character_Set) return Natural
is
begin
- return Wide_Search.Count (Source.Reference.all, Set);
+ return
+ Wide_Search.Count
+ (Source.Reference (1 .. Source.Last), Set);
end Count;
------------
function Delete
(Source : Unbounded_Wide_String;
From : Positive;
- Through : Natural)
- return Unbounded_Wide_String
+ Through : Natural) return Unbounded_Wide_String
is
begin
return
To_Unbounded_Wide_String
- (Wide_Fixed.Delete (Source.Reference.all, From, Through));
+ (Wide_Fixed.Delete
+ (Source.Reference (1 .. Source.Last), From, Through));
end Delete;
procedure Delete
(Source : in out Unbounded_Wide_String;
- From : in Positive;
- Through : in Natural)
+ From : Positive;
+ Through : Natural)
is
- Temp : Wide_String_Access := Source.Reference;
begin
- Source := To_Unbounded_Wide_String
- (Wide_Fixed.Delete (Temp.all, From, Through));
+ 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;
-------------
function Element
(Source : Unbounded_Wide_String;
- Index : Positive)
- return Wide_Character
+ Index : Positive) return Wide_Character
is
begin
- if Index <= Source.Reference.all'Last then
- return Source.Reference.all (Index);
+ if Index <= Source.Last then
+ return Source.Reference (Index);
else
raise Strings.Index_Error;
end if;
procedure Finalize (Object : in out Unbounded_Wide_String) is
procedure Deallocate is
- new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
+ 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;
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.all, Set, Test, First, Last);
+ 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;
----------
procedure Free (X : in out Wide_String_Access) is
procedure Deallocate is
new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
+
begin
- Deallocate (X);
+ -- Note: Do not try to free statically allocated null string
+
+ if X /= Null_Unbounded_Wide_String.Reference then
+ Deallocate (X);
+ end if;
end Free;
----------
function Head
(Source : Unbounded_Wide_String;
Count : Natural;
- Pad : Wide_Character := Wide_Space)
- return Unbounded_Wide_String
+ Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
is
begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Head (Source.Reference.all, Count, Pad));
+ 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 : in Natural;
- Pad : in Wide_Character := Wide_Space)
+ Count : Natural;
+ Pad : Wide_Character := Wide_Space)
is
+ Old : Wide_String_Access := Source.Reference;
begin
- Source := To_Unbounded_Wide_String
- (Wide_Fixed.Head (Source.Reference.all, Count, Pad));
+ Source.Reference :=
+ new Wide_String'
+ (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
+ Source.Last := Source.Reference'Length;
+ Free (Old);
end Head;
-----------
-----------
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
+ (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.all, Pattern, Going, Mapping);
+ Wide_Search.Index
+ (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
end Index;
function Index
- (Source : in Unbounded_Wide_String;
- Pattern : in Wide_String;
- Going : in Direction := Forward;
- Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
- return Natural
+ (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.all, Pattern, Going, Mapping);
+ 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
+ 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.all, Set, Test, Going);
+ 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
+ Going : Strings.Direction := Strings.Forward) return Natural
is
begin
- return Wide_Search.Index_Non_Blank (Source.Reference.all, Going);
+ 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;
----------------
procedure Initialize (Object : in out Unbounded_Wide_String) is
begin
Object.Reference := Null_Unbounded_Wide_String.Reference;
+ Object.Last := 0;
end Initialize;
------------
function Insert
(Source : Unbounded_Wide_String;
Before : Positive;
- New_Item : Wide_String)
- return Unbounded_Wide_String
+ New_Item : Wide_String) return Unbounded_Wide_String
is
begin
return
To_Unbounded_Wide_String
- (Wide_Fixed.Insert (Source.Reference.all, Before, New_Item));
+ (Wide_Fixed.Insert
+ (Source.Reference (1 .. Source.Last), Before, New_Item));
end Insert;
procedure Insert
(Source : in out Unbounded_Wide_String;
- Before : in Positive;
- New_Item : in Wide_String)
+ Before : Positive;
+ New_Item : Wide_String)
is
begin
- Source := To_Unbounded_Wide_String
- (Wide_Fixed.Insert (Source.Reference.all, Before, New_Item));
+ 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;
------------
function Length (Source : Unbounded_Wide_String) return Natural is
begin
- return Source.Reference.all'Length;
+ return Source.Last;
end Length;
---------------
---------------
function Overwrite
- (Source : Unbounded_Wide_String;
- Position : Positive;
- New_Item : Wide_String)
- return Unbounded_Wide_String is
-
+ (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.all, Position, New_Item));
+ 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 : in Positive;
- New_Item : in Wide_String)
+ Position : Positive;
+ New_Item : Wide_String)
is
- Temp : Wide_String_Access := Source.Reference;
+ NL : constant Natural := New_Item'Length;
begin
- Source := To_Unbounded_Wide_String
- (Wide_Fixed.Overwrite (Temp.all, Position, New_Item));
+ 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 --
---------------------
By : Wide_Character)
is
begin
- if Index <= Source.Reference.all'Last then
- Source.Reference.all (Index) := By;
+ if Index <= Source.Last then
+ Source.Reference (Index) := By;
else
raise Strings.Index_Error;
end if;
-------------------
function Replace_Slice
- (Source : Unbounded_Wide_String;
- Low : Positive;
- High : Natural;
- By : Wide_String)
- return Unbounded_Wide_String
+ (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.all, Low, High, By));
+ 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 : in Positive;
- High : in Natural;
- By : in Wide_String)
+ (Source : in out Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural;
+ By : Wide_String)
is
- Temp : Wide_String_Access := Source.Reference;
+ Old : Wide_String_Access := Source.Reference;
begin
- Source := To_Unbounded_Wide_String
- (Wide_Fixed.Replace_Slice (Temp.all, Low, High, By));
+ 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
+ High : Natural) return Wide_String
is
- Length : constant Natural := Source.Reference'Length;
-
begin
-- Note: test of High > Length is in accordance with AI95-00128
- if Low > Length + 1 or else High > Length then
+ if Low > Source.Last + 1 or else High > Source.Last then
raise Index_Error;
-
else
- declare
- Result : Wide_String (1 .. High - Low + 1);
-
- begin
- Result := Source.Reference.all (Low .. High);
- return Result;
- end;
+ return Source.Reference (Low .. High);
end if;
end Slice;
function Tail
(Source : Unbounded_Wide_String;
Count : Natural;
- Pad : Wide_Character := Wide_Space)
- return Unbounded_Wide_String is
-
+ Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is
begin
- return
- To_Unbounded_Wide_String
- (Wide_Fixed.Tail (Source.Reference.all, Count, Pad));
+ 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 : in Natural;
- Pad : in Wide_Character := Wide_Space)
+ Count : Natural;
+ Pad : Wide_Character := Wide_Space)
is
- Temp : Wide_String_Access := Source.Reference;
-
+ Old : Wide_String_Access := Source.Reference;
begin
- Source := To_Unbounded_Wide_String
- (Wide_Fixed.Tail (Temp.all, Count, Pad));
+ Source.Reference := new Wide_String'
+ (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
+ Source.Last := Source.Reference'Length;
+ Free (Old);
end Tail;
------------------------------
function To_Unbounded_Wide_String
(Source : Wide_String)
- return Unbounded_Wide_String
+ return Unbounded_Wide_String
is
Result : Unbounded_Wide_String;
-
begin
- Result.Reference := new Wide_String (1 .. Source'Length);
+ 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 : in Natural)
- return 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
+ return Wide_String
is
begin
- return Source.Reference.all;
+ return Source.Reference (1 .. Source.Last);
end To_Wide_String;
---------------
function Translate
(Source : Unbounded_Wide_String;
Mapping : Wide_Maps.Wide_Character_Mapping)
- return Unbounded_Wide_String
+ return Unbounded_Wide_String
is
begin
return
To_Unbounded_Wide_String
- (Wide_Fixed.Translate (Source.Reference.all, Mapping));
+ (Wide_Fixed.Translate
+ (Source.Reference (1 .. Source.Last), Mapping));
end Translate;
procedure Translate
Mapping : Wide_Maps.Wide_Character_Mapping)
is
begin
- Wide_Fixed.Translate (Source.Reference.all, Mapping);
+ Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
end Translate;
function Translate
- (Source : in Unbounded_Wide_String;
- Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
- return Unbounded_Wide_String
+ (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.all, Mapping));
+ (Wide_Fixed.Translate
+ (Source.Reference (1 .. Source.Last), Mapping));
end Translate;
procedure Translate
(Source : in out Unbounded_Wide_String;
- Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
+ Mapping : Wide_Maps.Wide_Character_Mapping_Function)
is
begin
- Wide_Fixed.Translate (Source.Reference.all, Mapping);
+ Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
end Translate;
----------
----------
function Trim
- (Source : in Unbounded_Wide_String;
- Side : in Trim_End)
- return Unbounded_Wide_String
+ (Source : Unbounded_Wide_String;
+ Side : Trim_End) return Unbounded_Wide_String
is
begin
return
To_Unbounded_Wide_String
- (Wide_Fixed.Trim (Source.Reference.all, Side));
+ (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
end Trim;
procedure Trim
(Source : in out Unbounded_Wide_String;
- Side : in Trim_End)
+ Side : Trim_End)
is
Old : Wide_String_Access := Source.Reference;
begin
- Source.Reference := new Wide_String'(Wide_Fixed.Trim (Old.all, Side));
+ 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 : in Unbounded_Wide_String;
- Left : in Wide_Maps.Wide_Character_Set;
- Right : in Wide_Maps.Wide_Character_Set)
- return Unbounded_Wide_String
+ (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.all, Left, Right));
+ (Wide_Fixed.Trim
+ (Source.Reference (1 .. Source.Last), Left, Right));
end Trim;
procedure Trim
(Source : in out Unbounded_Wide_String;
- Left : in Wide_Maps.Wide_Character_Set;
- Right : in Wide_Maps.Wide_Character_Set)
+ 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 (Old.all, Left, Right));
+ 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;
OSDN Git Service
