use Ada.Finalization;
- procedure Realloc_For_Chunk
- (Source : in out Unbounded_String;
- Chunk_Size : Natural);
- pragma Inline (Realloc_For_Chunk);
- -- Adjust the size allocated for the string. Add at least Chunk_Size so it
- -- is safe to add a string of this size at the end of the current content.
- -- The real size allocated for the string is Chunk_Size + x of the current
- -- string size. This buffered handling makes the Append unbounded string
- -- routines very fast.
-
---------
-- "&" --
---------
Result.Reference := new String (1 .. Result.Last);
K := 1;
- for I in 1 .. Left loop
+ for J in 1 .. Left loop
Result.Reference (K .. K + Len - 1) :=
Right.Reference (1 .. Right.Last);
K := K + Len;
procedure Adjust (Object : in out Unbounded_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
+ -- 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_String'Access then
pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String);
pragma Finalize_Storage_Only (Unbounded_String);
+ -- Finalization is required only for freeing storage
procedure Initialize (Object : in out Unbounded_String);
procedure Adjust (Object : in out Unbounded_String);
procedure Finalize (Object : in out Unbounded_String);
- -- Note: the following declaration is illegal since library level
- -- controlled objects are not allowed in preelaborated units. See
- -- AI-161 for a discussion of this issue and an attempt to address it.
- -- Meanwhile, what happens in GNAT is that this check is omitted for
- -- internal implementation units (see check in sem_cat.adb).
+ procedure Realloc_For_Chunk
+ (Source : in out Unbounded_String;
+ Chunk_Size : Natural);
+ pragma Inline (Realloc_For_Chunk);
+ -- Adjust the size allocated for the string. Add at least Chunk_Size so it
+ -- is safe to add a string of this size at the end of the current content.
+ -- The real size allocated for the string is Chunk_Size + x of the current
+ -- string size. This buffered handling makes the Append unbounded string
+ -- routines very fast. This spec is in the private part so that it can be
+ -- accessed from children (e.g. from Unbounded.Text_IO).
Null_Unbounded_String : constant Unbounded_String :=
- (AF.Controlled with Reference => Null_String'Access, Last => 0);
+ (AF.Controlled with
+ Reference => Null_String'Access,
+ Last => 0);
+ -- Note: this declaration is illegal since library level controlled
+ -- objects are not allowed in preelaborated units. See AI-161 for a
+ -- discussion of this issue and an attempt to address it. Meanwhile,
+ -- what happens in GNAT is that this check is omitted for internal
+ -- implementation units (see check in sem_cat.adb).
end Ada.Strings.Unbounded;
use Ada.Finalization;
- procedure Realloc_For_Chunk
- (Source : in out Unbounded_Wide_String;
- Chunk_Size : Natural);
- pragma Inline (Realloc_For_Chunk);
- -- Adjust the size allocated for the string. Add at least Chunk_Size so it
- -- is safe to add a string of this size at the end of the current
- -- content. The real size allocated for the string is Chunk_Size + x %
- -- of the current string size. This buffered handling makes the Append
- -- unbounded wide string routines very fast.
-
---------
-- "&" --
---------
Result.Reference (1) := Left;
Result.Reference (2 .. Result.Last) :=
Right.Reference (1 .. Right.Last);
-
return Result;
end "&";
Result : Unbounded_Wide_String;
begin
- Result.Last := Left;
+ Result.Last := Left;
Result.Reference := new Wide_String (1 .. Left);
for J in Result.Reference'Range loop
is
Len : constant Natural := Right.Last;
K : Positive;
- Result : Unbounded_Wide_String;
+ Result : Unbounded_Wide_String;
begin
Result.Last := Left * Len;
Result.Reference := new Wide_String (1 .. Result.Last);
K := 1;
- for I in 1 .. Left loop
+ for J in 1 .. Left loop
Result.Reference (K .. K + Len - 1) :=
Right.Reference (1 .. Right.Last);
K := K + Len;
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.
+ -- 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 :=
function Count
(Source : Unbounded_Wide_String;
Pattern : Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping :=
- Wide_Maps.Identity)
+ Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural
is
begin
- return Wide_Search.Count
- (Source.Reference (1 .. Source.Last), Pattern, Mapping);
+ return
+ Wide_Search.Count
+ (Source.Reference (1 .. Source.Last), Pattern, Mapping);
end Count;
function Count
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
is
begin
- return Wide_Search.Count
- (Source.Reference (1 .. Source.Last), Pattern, Mapping);
+ return
+ Wide_Search.Count
+ (Source.Reference (1 .. Source.Last), Pattern, Mapping);
end Count;
function Count
Set : Wide_Maps.Wide_Character_Set) return Natural
is
begin
- return Wide_Search.Count (Source.Reference (1 .. Source.Last), Set);
+ return
+ Wide_Search.Count
+ (Source.Reference (1 .. Source.Last), Set);
end Count;
------------
Through : Natural) return Unbounded_Wide_String
is
begin
- return To_Unbounded_Wide_String
- (Wide_Fixed.Delete
- (Source.Reference (1 .. Source.Last), From, Through));
+ return
+ To_Unbounded_Wide_String
+ (Wide_Fixed.Delete
+ (Source.Reference (1 .. Source.Last), From, Through));
end Delete;
procedure Delete
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 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
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));
+ return To_Unbounded_Wide_String
+ (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
end Head;
procedure Head
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.Reference :=
+ new Wide_String'
+ (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
Source.Last := Source.Reference'Length;
Free (Old);
end Head;
(Source : Unbounded_Wide_String;
Pattern : Wide_String;
Going : Strings.Direction := Strings.Forward;
- Mapping : Wide_Maps.Wide_Character_Mapping :=
- Wide_Maps.Identity) return Natural
+ 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);
+ return
+ Wide_Search.Index
+ (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
end Index;
function Index
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
is
begin
- return Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
+ return
+ Wide_Search.Index
+ (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
end Index;
function 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);
+ 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;
----------------
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));
+ return
+ To_Unbounded_Wide_String
+ (Wide_Fixed.Insert
+ (Source.Reference (1 .. Source.Last), Before, New_Item));
end Insert;
procedure Insert
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));
+ return
+ To_Unbounded_Wide_String
+ (Wide_Fixed.Overwrite
+ (Source.Reference (1 .. Source.Last), Position, New_Item));
end Overwrite;
procedure Overwrite
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
Alloc_Chunk_Size : constant Positive :=
Chunk_Size + (S_Length / Growth_Factor);
Tmp : Wide_String_Access;
-
begin
Tmp := new Wide_String (1 .. S_Length + Alloc_Chunk_Size);
Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
By : Wide_String) return Unbounded_Wide_String
is
begin
- return
- To_Unbounded_Wide_String
+ 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)
+ (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
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 --
-----------
if Low > Source.Last + 1 or else High > Source.Last then
raise Index_Error;
-
else
return Source.Reference (Low .. High);
end if;
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 (1 .. Source.Last), Count, Pad));
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));
------------------------------
function To_Unbounded_Wide_String
- (Source : Wide_String) return Unbounded_Wide_String
+ (Source : Wide_String)
+ return Unbounded_Wide_String
is
Result : Unbounded_Wide_String;
begin
return Result;
end To_Unbounded_Wide_String;
- --------------------
+ -------------------
-- To_Wide_String --
--------------------
function To_Wide_String
- (Source : Unbounded_Wide_String) return 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
+ 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));
+ return
+ To_Unbounded_Wide_String
+ (Wide_Fixed.Translate
+ (Source.Reference (1 .. Source.Last), Mapping));
end Translate;
procedure Translate
return Unbounded_Wide_String
is
begin
- return To_Unbounded_Wide_String
- (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
+ return
+ To_Unbounded_Wide_String
+ (Wide_Fixed.Translate
+ (Source.Reference (1 .. Source.Last), Mapping));
end Translate;
procedure Translate
Side : Trim_End) return Unbounded_Wide_String
is
begin
- return To_Unbounded_Wide_String
- (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
+ return
+ To_Unbounded_Wide_String
+ (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
end Trim;
procedure Trim
is
Old : Wide_String_Access := Source.Reference;
begin
- Source.Reference := new Wide_String'
- (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), 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 : Unbounded_Wide_String;
Left : Wide_Maps.Wide_Character_Set;
- Right : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String
+ 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));
+ return
+ To_Unbounded_Wide_String
+ (Wide_Fixed.Trim
+ (Source.Reference (1 .. Source.Last), Left, Right));
end Trim;
procedure Trim
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.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;
package Ada.Strings.Wide_Unbounded is
pragma Preelaborate (Wide_Unbounded);
-
type Unbounded_Wide_String is private;
Null_Unbounded_Wide_String : constant Unbounded_Wide_String;
(Length : Natural) return Unbounded_Wide_String;
function To_Wide_String
- (Source : Unbounded_Wide_String) return Wide_String;
+ (Source : Unbounded_Wide_String)
+ return Wide_String;
+
+ procedure Set_Unbounded_Wide_String
+ (Target : out Unbounded_Wide_String;
+ Source : Wide_String);
+ pragma Ada_05 (Set_Unbounded_Wide_String);
procedure Append
(Source : in out Unbounded_Wide_String;
New_Item : Wide_Character);
function "&"
- (Left, Right : Unbounded_Wide_String) return Unbounded_Wide_String;
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String;
function "&"
(Left : Unbounded_Wide_String;
Low : Positive;
High : Natural) return Wide_String;
+ function Unbounded_Slice
+ (Source : Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural) return Unbounded_Wide_String;
+ pragma Ada_05 (Unbounded_Slice);
+
+ procedure Unbounded_Slice
+ (Source : Unbounded_Wide_String;
+ Target : out Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural);
+ pragma Ada_05 (Unbounded_Slice);
+
function "="
(Left : Unbounded_Wide_String;
Right : Unbounded_Wide_String) return Boolean;
Test : Membership := Inside;
Going : Direction := Forward) return Natural;
+ 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;
+ pragma Ada_05 (Index);
+
+ function Index
+ (Source : Unbounded_Wide_String;
+ Pattern : Wide_String;
+ From : Positive;
+ Going : Direction := Forward;
+ Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural;
+ pragma Ada_05 (Index);
+
+ function Index
+ (Source : Unbounded_Wide_String;
+ Set : Wide_Maps.Wide_Character_Set;
+ From : Positive;
+ Test : Membership := Inside;
+ Going : Direction := Forward) return Natural;
+ pragma Ada_05 (Index);
+
function Index_Non_Blank
(Source : Unbounded_Wide_String;
Going : Direction := Forward) return Natural;
+ function Index_Non_Blank
+ (Source : Unbounded_Wide_String;
+ From : Positive;
+ Going : Direction := Forward) return Natural;
+ pragma Ada_05 (Index_Non_Blank);
+
function Count
(Source : Unbounded_Wide_String;
Pattern : Wide_String;
Last : out Natural);
------------------------------------
- -- Wide_String Translation Subprograms --
+ -- String Translation Subprograms --
------------------------------------
function Translate
(Source : Unbounded_Wide_String;
- Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String;
+ Mapping : Wide_Maps.Wide_Character_Mapping)
+ return Unbounded_Wide_String;
procedure Translate
(Source : in out Unbounded_Wide_String;
Mapping : Wide_Maps.Wide_Character_Mapping_Function);
---------------------------------------
- -- Wide_String Transformation Subprograms --
+ -- String Transformation Subprograms --
---------------------------------------
function Replace_Slice
By : Wide_String) return Unbounded_Wide_String;
procedure Replace_Slice
- (Source : in out Unbounded_Wide_String;
- Low : Positive;
- High : Natural;
- By : Wide_String);
+ (Source : in out Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural;
+ By : Wide_String);
function Insert
(Source : Unbounded_Wide_String;
New_Item : Wide_String) return Unbounded_Wide_String;
procedure Overwrite
- (Source : in out Unbounded_Wide_String;
- Position : Positive;
- New_Item : Wide_String);
+ (Source : in out Unbounded_Wide_String;
+ Position : Positive;
+ New_Item : Wide_String);
function Delete
(Source : Unbounded_Wide_String;
(Unbounded_Wide_String, To_Unbounded_Wide, To_Wide_String);
pragma Finalize_Storage_Only (Unbounded_Wide_String);
+ -- Finalization is required only for freeing storage
procedure Initialize (Object : in out Unbounded_Wide_String);
procedure Adjust (Object : in out Unbounded_Wide_String);
procedure Finalize (Object : in out Unbounded_Wide_String);
+ procedure Realloc_For_Chunk
+ (Source : in out Unbounded_Wide_String;
+ Chunk_Size : Natural);
+ -- Adjust the size allocated for the string. Add at least Chunk_Size so it
+ -- is safe to add a string of this size at the end of the current content.
+ -- The real size allocated for the string is Chunk_Size + x of the current
+ -- string size. This buffered handling makes the Append unbounded string
+ -- routines very fast.
+
Null_Unbounded_Wide_String : constant Unbounded_Wide_String :=
- (AF.Controlled with Reference => Null_Wide_String'Access, Last => 0);
+ (AF.Controlled with
+ Reference => Null_Wide_String'Access,
+ Last => 0);
+ -- Note: this declaration is illegal since library level controlled
+ -- objects are not allowed in preelaborated units. See AI-161 for a
+ -- discussion of this issue and an attempt to address it. Meanwhile,
+ -- what happens in GNAT is that this check is omitted for internal
+ -- implementation units (see check in sem_cat.adb).
end Ada.Strings.Wide_Unbounded;
use Ada.Finalization;
- procedure Realloc_For_Chunk
- (Source : in out Unbounded_Wide_Wide_String;
- Chunk_Size : Natural);
- pragma Inline (Realloc_For_Chunk);
- -- Adjust the size allocated for the string. Add at least Chunk_Size so it
- -- is safe to add a string of this size at the end of the current content.
- -- The real size allocated for the string is Chunk_Size + x of the current
- -- string size. This buffered handling makes the Append unbounded wide
- -- string routines very fast.
-
---------
-- "&" --
---------
Result.Reference (1) := Left;
Result.Reference (2 .. Result.Last) :=
Right.Reference (1 .. Right.Last);
-
return Result;
end "&";
Result : Unbounded_Wide_Wide_String;
begin
- Result.Last := Left;
+ Result.Last := Left;
Result.Reference := new Wide_Wide_String (1 .. Left);
for J in Result.Reference'Range loop
is
Len : constant Natural := Right.Last;
K : Positive;
- Result : Unbounded_Wide_Wide_String;
+ Result : Unbounded_Wide_Wide_String;
begin
Result.Last := Left * Len;
Result.Reference := new Wide_Wide_String (1 .. Result.Last);
K := 1;
- for I in 1 .. Left loop
+ for J in 1 .. Left loop
Result.Reference (K .. K + Len - 1) :=
Right.Reference (1 .. Right.Last);
K := K + Len;
(Source : Unbounded_Wide_Wide_String;
Pattern : Wide_Wide_String;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity) return Natural
+ Wide_Wide_Maps.Identity)
+ return Natural
is
begin
- return Wide_Wide_Search.Count
- (Source.Reference (1 .. Source.Last), Pattern, Mapping);
+ return
+ Wide_Wide_Search.Count
+ (Source.Reference (1 .. Source.Last), Pattern, Mapping);
end Count;
function Count
return Natural
is
begin
- return Wide_Wide_Search.Count
- (Source.Reference (1 .. Source.Last), Pattern, Mapping);
+ return
+ Wide_Wide_Search.Count
+ (Source.Reference (1 .. Source.Last), Pattern, Mapping);
end Count;
function Count
Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
is
begin
- return Wide_Wide_Search.Count
- (Source.Reference (1 .. Source.Last), Set);
+ return
+ Wide_Wide_Search.Count
+ (Source.Reference (1 .. Source.Last), Set);
end Count;
------------
Through : Natural) return Unbounded_Wide_Wide_String
is
begin
- return To_Unbounded_Wide_Wide_String
- (Wide_Wide_Fixed.Delete
- (Source.Reference (1 .. Source.Last), From, Through));
+ return
+ To_Unbounded_Wide_Wide_String
+ (Wide_Wide_Fixed.Delete
+ (Source.Reference (1 .. Source.Last), From, Through));
end Delete;
procedure Delete
procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
procedure Deallocate is
new Ada.Unchecked_Deallocation
- (Wide_Wide_String, Wide_Wide_String_Access);
+ (Wide_Wide_String, Wide_Wide_String_Access);
begin
-- Note: Don't try to free statically allocated null string
if Object.Reference /= Null_Wide_Wide_String'Access then
Deallocate (Object.Reference);
Object.Reference := Null_Unbounded_Wide_Wide_String.Reference;
+ Object.Last := 0;
end if;
end Finalize;
procedure Free (X : in out Wide_Wide_String_Access) is
procedure Deallocate is
new Ada.Unchecked_Deallocation
- (Wide_Wide_String, Wide_Wide_String_Access);
+ (Wide_Wide_String, Wide_Wide_String_Access);
+
begin
-- Note: Do not try to free statically allocated null string
return Unbounded_Wide_Wide_String
is
begin
- return
- To_Unbounded_Wide_Wide_String
- (Wide_Wide_Fixed.Head
- (Source.Reference (1 .. Source.Last), Count, Pad));
+ return To_Unbounded_Wide_Wide_String
+ (Wide_Wide_Fixed.Head
+ (Source.Reference (1 .. Source.Last), Count, Pad));
end Head;
procedure Head
Pad : Wide_Wide_Character := Wide_Wide_Space)
is
Old : Wide_Wide_String_Access := Source.Reference;
-
begin
- Source.Reference := new Wide_Wide_String'
- (Wide_Wide_Fixed.Head
- (Source.Reference (1 .. Source.Last), Count, Pad));
+ Source.Reference :=
+ new Wide_Wide_String'
+ (Wide_Wide_Fixed.Head
+ (Source.Reference (1 .. Source.Last), Count, Pad));
Source.Last := Source.Reference'Length;
Free (Old);
end Head;
Pattern : Wide_Wide_String;
Going : Strings.Direction := Strings.Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity) return Natural
+ Wide_Wide_Maps.Identity)
+ return Natural
is
begin
- return Wide_Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
+ return
+ Wide_Wide_Search.Index
+ (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
end Index;
function Index
return Natural
is
begin
- return Wide_Wide_Search.Index
- (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
+ return
+ Wide_Wide_Search.Index
+ (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
end Index;
function Index
(Source.Reference (1 .. Source.Last), Set, Test, Going);
end Index;
+ function Index
+ (Source : Unbounded_Wide_Wide_String;
+ Pattern : Wide_Wide_String;
+ From : Positive;
+ Going : Direction := Forward;
+ Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
+ Wide_Wide_Maps.Identity)
+ return Natural
+ is
+ begin
+ return
+ Wide_Wide_Search.Index
+ (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
+ end Index;
+
+ function Index
+ (Source : Unbounded_Wide_Wide_String;
+ Pattern : Wide_Wide_String;
+ From : Positive;
+ Going : Direction := Forward;
+ Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
+ return Natural
+ is
+ begin
+ return
+ Wide_Wide_Search.Index
+ (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
+ end Index;
+
+
+ function Index
+ (Source : Unbounded_Wide_Wide_String;
+ Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
+ From : Positive;
+ Test : Membership := Inside;
+ Going : Direction := Forward) return Natural
+ is
+ begin
+ return
+ Wide_Wide_Search.Index
+ (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
+ end Index;
+
function Index_Non_Blank
(Source : Unbounded_Wide_Wide_String;
Going : Strings.Direction := Strings.Forward) return Natural
is
begin
- return Wide_Wide_Search.Index_Non_Blank
- (Source.Reference (1 .. Source.Last), Going);
+ return
+ Wide_Wide_Search.Index_Non_Blank
+ (Source.Reference (1 .. Source.Last), Going);
+ end Index_Non_Blank;
+
+ function Index_Non_Blank
+ (Source : Unbounded_Wide_Wide_String;
+ From : Positive;
+ Going : Direction := Forward) return Natural
+ is
+ begin
+ return
+ Wide_Wide_Search.Index_Non_Blank
+ (Source.Reference (1 .. Source.Last), From, Going);
end Index_Non_Blank;
----------------
New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
is
begin
- return To_Unbounded_Wide_Wide_String
- (Wide_Wide_Fixed.Insert
- (Source.Reference (1 .. Source.Last), Before, New_Item));
+ return
+ To_Unbounded_Wide_Wide_String
+ (Wide_Wide_Fixed.Insert
+ (Source.Reference (1 .. Source.Last), Before, New_Item));
end Insert;
procedure Insert
New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
is
begin
- return To_Unbounded_Wide_Wide_String
- (Wide_Wide_Fixed.Overwrite
- (Source.Reference (1 .. Source.Last), Position, New_Item));
+ return
+ To_Unbounded_Wide_Wide_String
+ (Wide_Wide_Fixed.Overwrite
+ (Source.Reference (1 .. Source.Last), Position, New_Item));
end Overwrite;
procedure Overwrite
New_Item : Wide_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_Wide_String_Access := Source.Reference;
-
begin
Source.Reference := new Wide_Wide_String'
(Wide_Wide_Fixed.Overwrite
Alloc_Chunk_Size : constant Positive :=
Chunk_Size + (S_Length / Growth_Factor);
Tmp : Wide_Wide_String_Access;
-
begin
Tmp := new Wide_Wide_String (1 .. S_Length + Alloc_Chunk_Size);
Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
By : Wide_Wide_String) return Unbounded_Wide_Wide_String
is
begin
- return
- To_Unbounded_Wide_Wide_String
+ return To_Unbounded_Wide_Wide_String
(Wide_Wide_Fixed.Replace_Slice
(Source.Reference (1 .. Source.Last), Low, High, By));
end Replace_Slice;
procedure Replace_Slice
- (Source : in out Unbounded_Wide_Wide_String;
- Low : Positive;
- High : Natural;
- By : Wide_Wide_String)
+ (Source : in out Unbounded_Wide_Wide_String;
+ Low : Positive;
+ High : Natural;
+ By : Wide_Wide_String)
is
Old : Wide_Wide_String_Access := Source.Reference;
-
begin
Source.Reference := new Wide_Wide_String'
(Wide_Wide_Fixed.Replace_Slice
Free (Old);
end Replace_Slice;
+ ------------------------------------
+ -- Set_Unbounded_Wide_Wide_String --
+ ------------------------------------
+
+ procedure Set_Unbounded_Wide_Wide_String
+ (Target : out Unbounded_Wide_Wide_String;
+ Source : Wide_Wide_String)
+ is
+ begin
+ Target.Last := Source'Length;
+ Target.Reference := new Wide_Wide_String (1 .. Source'Length);
+ Target.Reference.all := Source;
+ end Set_Unbounded_Wide_Wide_String;
+
-----------
-- Slice --
-----------
if Low > Source.Last + 1 or else High > Source.Last then
raise Index_Error;
-
else
return Source.Reference (Low .. High);
end if;
(Source : Unbounded_Wide_Wide_String;
Count : Natural;
Pad : Wide_Wide_Character := Wide_Wide_Space)
- return Unbounded_Wide_Wide_String
- is
+ return Unbounded_Wide_Wide_String is
begin
return To_Unbounded_Wide_Wide_String
(Wide_Wide_Fixed.Tail
Pad : Wide_Wide_Character := Wide_Wide_Space)
is
Old : Wide_Wide_String_Access := Source.Reference;
-
begin
Source.Reference := new Wide_Wide_String'
(Wide_Wide_Fixed.Tail
return Result;
end To_Unbounded_Wide_Wide_String;
- --------------------
+ -------------------
-- To_Wide_Wide_String --
--------------------
return Source.Reference (1 .. Source.Last);
end To_Wide_Wide_String;
+
---------------
-- Translate --
---------------
return Unbounded_Wide_Wide_String
is
begin
- return To_Unbounded_Wide_Wide_String
- (Wide_Wide_Fixed.Translate
- (Source.Reference (1 .. Source.Last), Mapping));
+ return
+ To_Unbounded_Wide_Wide_String
+ (Wide_Wide_Fixed.Translate
+ (Source.Reference (1 .. Source.Last), Mapping));
end Translate;
procedure Translate
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
is
begin
- Wide_Wide_Fixed.Translate
- (Source.Reference (1 .. Source.Last), Mapping);
+ Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
end Translate;
function Translate
return Unbounded_Wide_Wide_String
is
begin
- return To_Unbounded_Wide_Wide_String
- (Wide_Wide_Fixed.Translate
- (Source.Reference (1 .. Source.Last), Mapping));
+ return
+ To_Unbounded_Wide_Wide_String
+ (Wide_Wide_Fixed.Translate
+ (Source.Reference (1 .. Source.Last), Mapping));
end Translate;
procedure Translate
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
is
begin
- Wide_Wide_Fixed.Translate
- (Source.Reference (1 .. Source.Last), Mapping);
+ Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
end Translate;
----------
Side : Trim_End) return Unbounded_Wide_Wide_String
is
begin
- return To_Unbounded_Wide_Wide_String
- (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
+ return
+ To_Unbounded_Wide_Wide_String
+ (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
end Trim;
procedure Trim
return Unbounded_Wide_Wide_String
is
begin
- return To_Unbounded_Wide_Wide_String
- (Wide_Wide_Fixed.Trim
- (Source.Reference (1 .. Source.Last), Left, Right));
+ return
+ To_Unbounded_Wide_Wide_String
+ (Wide_Wide_Fixed.Trim
+ (Source.Reference (1 .. Source.Last), Left, Right));
end Trim;
procedure Trim
is
Old : Wide_Wide_String_Access := Source.Reference;
begin
- Source.Reference := new Wide_Wide_String'
- (Wide_Wide_Fixed.Trim
- (Source.Reference (1 .. Source.Last), Left, Right));
+ Source.Reference :=
+ new Wide_Wide_String'
+ (Wide_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_Wide_String;
+ Low : Positive;
+ High : Natural) return Unbounded_Wide_Wide_String
+ is
+ begin
+ if Low > Source.Last + 1 or else High > Source.Last then
+ raise Index_Error;
+ else
+ return
+ To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
+ end if;
+ end Unbounded_Slice;
+
+ procedure Unbounded_Slice
+ (Source : Unbounded_Wide_Wide_String;
+ Target : out Unbounded_Wide_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_Wide_String (Source.Reference.all (Low .. High));
+ end if;
+ end Unbounded_Slice;
+
end Ada.Strings.Wide_Wide_Unbounded;
package Ada.Strings.Wide_Wide_Unbounded is
pragma Preelaborate (Wide_Wide_Unbounded);
-
type Unbounded_Wide_Wide_String is private;
Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String;
function To_Wide_Wide_String
(Source : Unbounded_Wide_Wide_String) return Wide_Wide_String;
+ procedure Set_Unbounded_Wide_Wide_String
+ (Target : out Unbounded_Wide_Wide_String;
+ Source : Wide_Wide_String);
+ pragma Ada_05 (Set_Unbounded_Wide_Wide_String);
+
procedure Append
(Source : in out Unbounded_Wide_Wide_String;
New_Item : Unbounded_Wide_Wide_String);
New_Item : Wide_Wide_Character);
function "&"
- (Left, Right : Unbounded_Wide_Wide_String)
- return Unbounded_Wide_Wide_String;
+ (Left : Unbounded_Wide_Wide_String;
+ Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String;
function "&"
(Left : Unbounded_Wide_Wide_String;
Low : Positive;
High : Natural) return Wide_Wide_String;
+ function Unbounded_Slice
+ (Source : Unbounded_Wide_Wide_String;
+ Low : Positive;
+ High : Natural) return Unbounded_Wide_Wide_String;
+ pragma Ada_05 (Unbounded_Slice);
+
+ procedure Unbounded_Slice
+ (Source : Unbounded_Wide_Wide_String;
+ Target : out Unbounded_Wide_Wide_String;
+ Low : Positive;
+ High : Natural);
+ pragma Ada_05 (Unbounded_Slice);
+
function "="
(Left : Unbounded_Wide_Wide_String;
Right : Unbounded_Wide_Wide_String) return Boolean;
Pattern : Wide_Wide_String;
Going : Direction := Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity) return Natural;
+ Wide_Wide_Maps.Identity)
+ return Natural;
function Index
(Source : Unbounded_Wide_Wide_String;
Test : Membership := Inside;
Going : Direction := Forward) return Natural;
+ function Index
+ (Source : Unbounded_Wide_Wide_String;
+ Pattern : Wide_Wide_String;
+ From : Positive;
+ Going : Direction := Forward;
+ Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
+ Wide_Wide_Maps.Identity)
+ return Natural;
+ pragma Ada_05 (Index);
+
+ function Index
+ (Source : Unbounded_Wide_Wide_String;
+ Pattern : Wide_Wide_String;
+ From : Positive;
+ Going : Direction := Forward;
+ Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
+ return Natural;
+ pragma Ada_05 (Index);
+
+ function Index
+ (Source : Unbounded_Wide_Wide_String;
+ Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
+ From : Positive;
+ Test : Membership := Inside;
+ Going : Direction := Forward) return Natural;
+ pragma Ada_05 (Index);
+
+ function Index_Non_Blank
+ (Source : Unbounded_Wide_Wide_String;
+ Going : Direction := Forward) return Natural;
+
function Index_Non_Blank
(Source : Unbounded_Wide_Wide_String;
+ From : Positive;
Going : Direction := Forward) return Natural;
+ pragma Ada_05 (Index_Non_Blank);
function Count
(Source : Unbounded_Wide_Wide_String;
Pattern : Wide_Wide_String;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity) return Natural;
+ Wide_Wide_Maps.Identity)
+ return Natural;
function Count
(Source : Unbounded_Wide_Wide_String;
Last : out Natural);
------------------------------------
- -- Wide_Wide_String Translation Subprograms --
+ -- String Translation Subprograms --
------------------------------------
function Translate
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function);
---------------------------------------
- -- Wide_Wide_String Transformation Subprograms --
+ -- String Transformation Subprograms --
---------------------------------------
function Replace_Slice
By : Wide_Wide_String) return Unbounded_Wide_Wide_String;
procedure Replace_Slice
- (Source : in out Unbounded_Wide_Wide_String;
- Low : Positive;
- High : Natural;
- By : Wide_Wide_String);
+ (Source : in out Unbounded_Wide_Wide_String;
+ Low : Positive;
+ High : Natural;
+ By : Wide_Wide_String);
function Insert
(Source : Unbounded_Wide_Wide_String;
New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String;
procedure Overwrite
- (Source : in out Unbounded_Wide_Wide_String;
- Position : Positive;
- New_Item : Wide_Wide_String);
+ (Source : in out Unbounded_Wide_Wide_String;
+ Position : Positive;
+ New_Item : Wide_Wide_String);
function Delete
(Source : Unbounded_Wide_Wide_String;
function To_Unbounded_Wide
(S : Wide_Wide_String) return Unbounded_Wide_Wide_String
- renames To_Unbounded_Wide_Wide_String;
+ renames To_Unbounded_Wide_Wide_String;
type Unbounded_Wide_Wide_String is new AF.Controlled with record
Reference : Wide_Wide_String_Access := Null_Wide_Wide_String'Access;
- Last : Natural := 0;
+ Last : Natural := 0;
end record;
-- The Unbounded_Wide_Wide_String is using a buffered implementation to
(Unbounded_Wide_Wide_String, To_Unbounded_Wide, To_Wide_Wide_String);
pragma Finalize_Storage_Only (Unbounded_Wide_Wide_String);
+ -- Finalization is required only for freeing storage
procedure Initialize (Object : in out Unbounded_Wide_Wide_String);
procedure Adjust (Object : in out Unbounded_Wide_Wide_String);
procedure Finalize (Object : in out Unbounded_Wide_Wide_String);
+ procedure Realloc_For_Chunk
+ (Source : in out Unbounded_Wide_Wide_String;
+ Chunk_Size : Natural);
+ -- Adjust the size allocated for the string. Add at least Chunk_Size so it
+ -- is safe to add a string of this size at the end of the current content.
+ -- The real size allocated for the string is Chunk_Size + x of the current
+ -- string size. This buffered handling makes the Append unbounded string
+ -- routines very fast.
Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String :=
- (AF.Controlled with Reference => Null_Wide_Wide_String'Access, Last => 0);
+ (AF.Controlled with
+ Reference =>
+ Null_Wide_Wide_String'Access,
+ Last => 0);
+ -- Note: this declaration is illegal since library level controlled
+ -- objects are not allowed in preelaborated units. See AI-161 for a
+ -- discussion of this issue and an attempt to address it. Meanwhile,
+ -- what happens in GNAT is that this check is omitted for internal
+ -- implementation units (see check in sem_cat.adb).
end Ada.Strings.Wide_Wide_Unbounded;
-- --
------------------------------------------------------------------------------
-with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux;
-with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Text_IO; use Ada.Text_IO;
package body Ada.Strings.Unbounded.Text_IO is
Str1 := Str2;
end loop;
- Set_String (Result, Str1);
+ Result.Reference := Str1;
+ Result.Last := Str1'Length;
return Result;
end Get_Line;
Str1 := Str2;
end loop;
- Set_String (Result, Str1);
+ Result.Reference := Str1;
+ Result.Last := Str1'Length;
return Result;
end Get_Line;
procedure Get_Line (Item : out Unbounded_String) is
- Buffer : String (1 .. 1000);
- Last : Natural;
- Str1 : String_Access;
- Str2 : String_Access;
-
begin
- Get_Line (Buffer, Last);
- Str1 := new String'(Buffer (1 .. Last));
- while Last = Buffer'Last loop
- Get_Line (Buffer, Last);
- Str2 := new String'(Str1.all & Buffer (1 .. Last));
- Free (Str1);
- Str1 := Str2;
- end loop;
-
- Set_String (Item, Str1);
+ Get_Line (Current_Input, Item);
end Get_Line;
procedure Get_Line
(File : Ada.Text_IO.File_Type;
Item : out Unbounded_String)
is
- Buffer : String (1 .. 1000);
- Last : Natural;
- Str1 : String_Access;
- Str2 : String_Access;
-
begin
- Get_Line (File, Buffer, Last);
- Str1 := new String'(Buffer (1 .. Last));
- while Last = Buffer'Last loop
- Get_Line (Buffer, Last);
- Str2 := new String'(Str1.all & Buffer (1 .. Last));
- Free (Str1);
- Str1 := Str2;
- end loop;
+ -- We are going to read into the string that is already there and
+ -- allocated. Hopefully it is big enough now, if not, we will extend
+ -- it in the usual manner using Realloc_For_Chunk.
- Set_String (Item, Str1);
+ -- Make sure we start with at least 80 characters
+
+ if Item.Reference'Last < 80 then
+ Realloc_For_Chunk (Item, 80);
+ end if;
+
+ -- Loop to read data, filling current string as far as possible.
+ -- Item.Last holds the number of characters read so far.
+
+ Item.Last := 0;
+ loop
+ Get_Line
+ (File,
+ Item.Reference (Item.Last + 1 .. Item.Reference'Last),
+ Item.Last);
+
+ -- If we hit the end of the line before the end of the buffer, then
+ -- we are all done, and the result length is properly set.
+
+ if Item.Last < Item.Reference'Last then
+ return;
+ end if;
+
+ -- If not enough room, double it and keep reading
+
+ Realloc_For_Chunk (Item, Item.Last);
+ end loop;
end Get_Line;
---------
procedure Put (U : Unbounded_String) is
begin
- Put (Get_String (U).all);
+ Put (U.Reference (1 .. U.Last));
end Put;
procedure Put (File : File_Type; U : Unbounded_String) is
begin
- Put (File, Get_String (U).all);
+ Put (File, U.Reference (1 .. U.Last));
end Put;
--------------
procedure Put_Line (U : Unbounded_String) is
begin
- Put_Line (Get_String (U).all);
+ Put_Line (U.Reference (1 .. U.Last));
end Put_Line;
procedure Put_Line (File : File_Type; U : Unbounded_String) is
begin
- Put_Line (File, Get_String (U).all);
+ Put_Line (File, U.Reference (1 .. U.Last));
end Put_Line;
end Ada.Strings.Unbounded.Text_IO;
-- --
------------------------------------------------------------------------------
-with Ada.Strings.Wide_Unbounded.Aux; use Ada.Strings.Wide_Unbounded.Aux;
-with Ada.Wide_Text_IO; use Ada.Wide_Text_IO;
+with Ada.Wide_Text_IO; use Ada.Wide_Text_IO;
package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is
Str1 := Str2;
end loop;
- Set_Wide_String (Result, Str1);
+ Result.Reference := Str1;
+ Result.Last := Str1'Length;
return Result;
end Get_Line;
Str1 := Str2;
end loop;
- Set_Wide_String (Result, Str1);
+ Result.Reference := Str1;
+ Result.Last := Str1'Length;
return Result;
end Get_Line;
procedure Get_Line (Item : out Unbounded_Wide_String) is
- Buffer : Wide_String (1 .. 1000);
- Last : Natural;
- Str1 : Wide_String_Access;
- Str2 : Wide_String_Access;
-
begin
- Get_Line (Buffer, Last);
- Str1 := new Wide_String'(Buffer (1 .. Last));
- while Last = Buffer'Last loop
- Get_Line (Buffer, Last);
- Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last));
- Free (Str1);
- Str1 := Str2;
- end loop;
-
- Set_Wide_String (Item, Str1);
+ Get_Line (Current_Input, Item);
end Get_Line;
procedure Get_Line
(File : Ada.Wide_Text_IO.File_Type;
Item : out Unbounded_Wide_String)
is
- Buffer : Wide_String (1 .. 1000);
- Last : Natural;
- Str1 : Wide_String_Access;
- Str2 : Wide_String_Access;
-
begin
- Get_Line (File, Buffer, Last);
- Str1 := new Wide_String'(Buffer (1 .. Last));
- while Last = Buffer'Last loop
- Get_Line (Buffer, Last);
- Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last));
- Free (Str1);
- Str1 := Str2;
- end loop;
+ -- We are going to read into the string that is already there and
+ -- allocated. Hopefully it is big enough now, if not, we will extend
+ -- it in the usual manner using Realloc_For_Chunk.
- Set_Wide_String (Item, Str1);
+ -- Make sure we start with at least 80 characters
+
+ if Item.Reference'Last < 80 then
+ Realloc_For_Chunk (Item, 80);
+ end if;
+
+ -- Loop to read data, filling current string as far as possible.
+ -- Item.Last holds the number of characters read so far.
+
+ Item.Last := 0;
+ loop
+ Get_Line
+ (File,
+ Item.Reference (Item.Last + 1 .. Item.Reference'Last),
+ Item.Last);
+
+ -- If we hit the end of the line before the end of the buffer, then
+ -- we are all done, and the result length is properly set.
+
+ if Item.Last < Item.Reference'Last then
+ return;
+ end if;
+
+ -- If not enough room, double it and keep reading
+
+ Realloc_For_Chunk (Item, Item.Last);
+ end loop;
end Get_Line;
---------
procedure Put (U : Unbounded_Wide_String) is
begin
- Put (Get_Wide_String (U).all);
+ Put (U.Reference (1 .. U.Last));
end Put;
procedure Put (File : File_Type; U : Unbounded_Wide_String) is
begin
- Put (File, Get_Wide_String (U).all);
+ Put (File, U.Reference (1 .. U.Last));
end Put;
--------------
procedure Put_Line (U : Unbounded_Wide_String) is
begin
- Put_Line (Get_Wide_String (U).all);
+ Put_Line (U.Reference (1 .. U.Last));
end Put_Line;
procedure Put_Line (File : File_Type; U : Unbounded_Wide_String) is
begin
- Put_Line (File, Get_Wide_String (U).all);
+ Put_Line (File, U.Reference (1 .. U.Last));
end Put_Line;
end Ada.Strings.Wide_Unbounded.Wide_Text_IO;
-- --
------------------------------------------------------------------------------
-with Ada.Strings.Wide_Wide_Unbounded.Aux;
-use Ada.Strings.Wide_Wide_Unbounded.Aux;
-with Ada.Wide_Wide_Text_IO;
-use Ada.Wide_Wide_Text_IO;
+with Ada.Wide_Wide_Text_IO; use Ada.Wide_Wide_Text_IO;
package body Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO is
Str1 := Str2;
end loop;
- Set_Wide_Wide_String (Result, Str1);
+ Result.Reference := Str1;
+ Result.Last := Str1'Length;
return Result;
end Get_Line;
function Get_Line
- (File : Ada.Wide_Wide_Text_IO.File_Type)
- return Unbounded_Wide_Wide_String
+ (File : Ada.Wide_Wide_Text_IO.File_Type) return Unbounded_Wide_Wide_String
is
Buffer : Wide_Wide_String (1 .. 1000);
Last : Natural;
Str1 := Str2;
end loop;
- Set_Wide_Wide_String (Result, Str1);
+ Result.Reference := Str1;
+ Result.Last := Str1'Length;
return Result;
end Get_Line;
procedure Get_Line (Item : out Unbounded_Wide_Wide_String) is
- Buffer : Wide_Wide_String (1 .. 1000);
- Last : Natural;
- Str1 : Wide_Wide_String_Access;
- Str2 : Wide_Wide_String_Access;
-
begin
- Get_Line (Buffer, Last);
- Str1 := new Wide_Wide_String'(Buffer (1 .. Last));
- while Last = Buffer'Last loop
- Get_Line (Buffer, Last);
- Str2 := new Wide_Wide_String'(Str1.all & Buffer (1 .. Last));
- Free (Str1);
- Str1 := Str2;
- end loop;
-
- Set_Wide_Wide_String (Item, Str1);
+ Get_Line (Current_Input, Item);
end Get_Line;
procedure Get_Line
(File : Ada.Wide_Wide_Text_IO.File_Type;
Item : out Unbounded_Wide_Wide_String)
is
- Buffer : Wide_Wide_String (1 .. 1000);
- Last : Natural;
- Str1 : Wide_Wide_String_Access;
- Str2 : Wide_Wide_String_Access;
-
begin
- Get_Line (File, Buffer, Last);
- Str1 := new Wide_Wide_String'(Buffer (1 .. Last));
- while Last = Buffer'Last loop
- Get_Line (Buffer, Last);
- Str2 := new Wide_Wide_String'(Str1.all & Buffer (1 .. Last));
- Free (Str1);
- Str1 := Str2;
- end loop;
+ -- We are going to read into the string that is already there and
+ -- allocated. Hopefully it is big enough now, if not, we will extend
+ -- it in the usual manner using Realloc_For_Chunk.
- Set_Wide_Wide_String (Item, Str1);
+ -- Make sure we start with at least 80 characters
+
+ if Item.Reference'Last < 80 then
+ Realloc_For_Chunk (Item, 80);
+ end if;
+
+ -- Loop to read data, filling current string as far as possible.
+ -- Item.Last holds the number of characters read so far.
+
+ Item.Last := 0;
+ loop
+ Get_Line
+ (File,
+ Item.Reference (Item.Last + 1 .. Item.Reference'Last),
+ Item.Last);
+
+ -- If we hit the end of the line before the end of the buffer, then
+ -- we are all done, and the result length is properly set.
+
+ if Item.Last < Item.Reference'Last then
+ return;
+ end if;
+
+ -- If not enough room, double it and keep reading
+
+ Realloc_For_Chunk (Item, Item.Last);
+ end loop;
end Get_Line;
---------
procedure Put (U : Unbounded_Wide_Wide_String) is
begin
- Put (Get_Wide_Wide_String (U).all);
+ Put (U.Reference (1 .. U.Last));
end Put;
procedure Put (File : File_Type; U : Unbounded_Wide_Wide_String) is
begin
- Put (File, Get_Wide_Wide_String (U).all);
+ Put (File, U.Reference (1 .. U.Last));
end Put;
--------------
procedure Put_Line (U : Unbounded_Wide_Wide_String) is
begin
- Put_Line (Get_Wide_Wide_String (U).all);
+ Put_Line (U.Reference (1 .. U.Last));
end Put_Line;
procedure Put_Line (File : File_Type; U : Unbounded_Wide_Wide_String) is
begin
- Put_Line (File, Get_Wide_Wide_String (U).all);
+ Put_Line (File, U.Reference (1 .. U.Last));
end Put_Line;
end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;
OSDN Git Service
