OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Ada.Strings.Unbounded.Aux.Set_String 

gcc/ada/

	* libgnat/a-stunau.ads, libgnat/a-stunau.adb,
	libgnat/a-stunau__shared.adb (Set_String): Remove old version,
	replace by a new version taking a callback to set the string.
This commit is contained in:
Arnaud Charlet 2021-01-01 05:35:47 -05:00 committed by Pierre-Marie de Rodat
parent 2f18a0c2a9
commit 5f5e3854c9
3 changed files with 45 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/libgnat/a-stunau.adb
View File

@ -52,11 +52,17 @@ package body Ada.Strings.Unbounded.Aux is
-- Set_String --
----------------
procedure Set_String (UP : in out Unbounded_String; S : String_Access) is
procedure Set_String
(U : out Unbounded_String;
Length : Positive;
Set : not null access procedure (S : out String))
is
Old : String_Access := U.Reference;
begin
Finalize (UP);
UP.Reference := S;
UP.Last := UP.Reference'Length;
U.Last := Length;
U.Reference := new String (1 .. Length);
Set (U.Reference.all);
Free (Old);
end Set_String;
end Ada.Strings.Unbounded.Aux;

22
gcc/ada/libgnat/a-stunau.ads
View File

@ -56,22 +56,24 @@ package Ada.Strings.Unbounded.Aux is
S : out Big_String_Access;
L : out Natural);
pragma Inline (Get_String);
-- This procedure returns the internal string pointer used in the
-- representation of an unbounded string as well as the actual current
-- length (which may be less than S.all'Length because in general there
-- can be extra space assigned). The characters of this string may be
-- not be modified via the returned pointer, and are valid only as
-- long as the original unbounded string is not accessed or modified.
-- Return the internal string pointer used in the representation of an
-- unbounded string as well as the actual current length (which may be less
-- than S.all'Length because in general there can be extra space assigned).
-- The characters of this string may be not be modified via the returned
-- pointer, and are valid only as long as the original unbounded string is
-- not accessed or modified.
--
-- This procedure is much more efficient than the use of To_String
-- since it avoids the need to copy the string. The lower bound of the
-- referenced string returned by this call is always one, so the actual
-- string data is always accessible as S (1 .. L).
procedure Set_String (UP : in out Unbounded_String; S : String_Access);
procedure Set_String
(U : out Unbounded_String;
Length : Positive;
Set : not null access procedure (S : out String));
pragma Inline (Set_String);
-- This version of Set_Unbounded_String takes a string access value, rather
-- than a string. The lower bound of the string value is required to be
-- one, and this requirement is not checked.
-- Create an unbounded string U with the given Length, using Set to fill
-- the contents of U.
end Ada.Strings.Unbounded.Aux;

28
gcc/ada/libgnat/a-stunau__shared.adb
View File

@ -51,12 +51,30 @@ package body Ada.Strings.Unbounded.Aux is
-- Set_String --
----------------
procedure Set_String (UP : in out Unbounded_String; S : String_Access) is
X : String_Access := S;
procedure Set_String
(U : out Unbounded_String;
Length : Positive;
Set : not null access procedure (S : out String))
is
TR : constant Shared_String_Access := U.Reference;
DR : Shared_String_Access;
begin
Set_Unbounded_String (UP, S.all);
Free (X);
-- Try to reuse existing shared string
if Can_Be_Reused (TR, Length) then
Reference (TR);
DR := TR;
-- Otherwise allocate new shared string
else
DR := Allocate (Length);
U.Reference := DR;
end if;
Set (DR.Data (1 .. Length));
DR.Last := Length;
Unreference (TR);
end Set_String;
end Ada.Strings.Unbounded.Aux;